commit cff04de7acb8a578068c7478770a75664b73111e
parent f504a18021106589e7cf3630710dd9abbe80c3f1
Author: Alexander Burger <abu@software-lab.de>
Date: Tue, 20 Nov 2012 18:43:27 +0100
Emacs-style editing
Diffstat:
| M | CREDITS | | | 3 | +++ |
| M | lib.l | | | 7 | +++++-- |
| M | lib/debug.l | | | 105 | +++++++++++++++++++++++++++++++++++++++++++++---------------------------------- |
| A | lib/eedit.l | | | 130 | +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
| A | lib/el/picolisp-wiki-mode.el | | | 1177 | +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
| M | lib/el/picolisp.el | | | 206 | +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-- |
| A | lib/eled.l | | | 630 | +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
| M | lib/led.l | | | 25 | +++++++++++++++++-------- |
8 files changed, 2223 insertions(+), 60 deletions(-)
diff --git a/CREDITS b/CREDITS
@@ -30,3 +30,6 @@ Nikolai Zobnin <nikolai.zobnin@gmail.com>
# Package maintenance
Kan-Ru Chen <koster@debian.org>
+
+# Emacs-style editing
+Thorsten Jolitz <tjolitz@gmail.com>
diff --git a/lib.l b/lib.l
@@ -1,4 +1,4 @@
-# 09jul12abu
+# 20nov12abu
# (c) Software Lab. Alexander Burger
(de task (Key . Prg)
@@ -456,7 +456,10 @@
### Debug ###
`*Dbg
-(load "@lib/debug.l" "@lib/led.l" "@lib/edit.l" "@lib/lint.l")
+(if (info (pil "editor"))
+ (load (pil "editor"))
+ (load "@lib/led.l" "@lib/edit.l") )
+(load "@lib/debug.l" "@lib/lint.l")
(noLint 'later (loc "@Prg" later))
# vi:et:ts=3:sw=3
diff --git a/lib/debug.l b/lib/debug.l
@@ -1,4 +1,4 @@
-# 17nov12abu
+# 20nov12abu
# (c) Software Lab. Alexander Burger
# Prompt
@@ -136,7 +136,7 @@
(dep2 (+ 3 N) "X") ) ) )
# Source code
-(off "*Vi")
+(off "*Ed")
(in "@lib/map"
(while (read)
@@ -145,56 +145,71 @@
(set @ (read))
(put Sym '*Dbg (cons (read))) ) ) ) )
-(de vi ("X" C)
- (when (pair "X")
- (setq C (cdr "X") "X" (car "X")) )
- (when
- (if "X"
- (setq "*Vi"
+(de _ed ("Ed" . "Prg")
+ (ifn "X"
+ (eval
+ (out (pil "editor")
+ (println (cons 'load "Ed")) ) )
+ (when (pair "X")
+ (setq C (cdr "X") "X" (car "X")) )
+ (when
+ (setq "*Ed"
(if C
(get C '*Dbg -1 "X")
(get "X" '*Dbg 1) ) )
- "*Vi" )
- (out (tmp "tags")
- (let D (pack (pwd) "/")
- (for Lst
- (group # (file (line . sym) (line . sym) ..)
- (extract
- '((This)
- (when (: *Dbg)
- (cons (path (cdar @)) (caar @) This) ) )
- (all) ) )
- (let Tags
- (in (car Lst)
- (let (Line 1 Ofs 0)
- (mapcar
- '((X)
- (do (- (car X) Line)
- (inc 'Ofs (inc (size (line T)))) )
- (pack
- `(pack "^J" (char 127))
- (cdr X)
- (char 1)
- (setq Line (car X))
- ","
- Ofs ) )
- (sort (cdr Lst)) ) ) )
- (prinl
- "^L^J"
- (unless (= `(char "/") (char (car Lst))) D)
- (car Lst)
- ","
- (sum size Tags)
- Tags ) ) ) ) )
- (call 'vim
+ (out (tmp "tags")
+ (let D (pack (pwd) "/")
+ (for Lst
+ (group # (file (line . sym) (line . sym) ..)
+ (extract
+ '((This)
+ (when (: *Dbg)
+ (cons (path (cdar @)) (caar @) This) ) )
+ (all) ) )
+ (let Tags
+ (in (car Lst)
+ (let (Line 1 Ofs 0)
+ (mapcar
+ '((X)
+ (do (- (car X) Line)
+ (inc 'Ofs (inc (size (line T)))) )
+ (pack
+ `(pack "^J" (char 127))
+ (cdr X)
+ (char 1)
+ (setq Line (car X))
+ ","
+ Ofs ) )
+ (sort (cdr Lst)) ) ) )
+ (prinl
+ "^L^J"
+ (unless (= `(char "/") (char (car Lst))) D)
+ (car Lst)
+ ","
+ (sum size Tags)
+ Tags ) ) ) ) )
+ (run "Prg") ) )
+ "X" )
+
+(de vi ("X" C)
+ (_ed
+ '("@lib/led.l" "@lib/edit.l")
+ (call "vim"
(pack "+set tags=" (tmp "tags") ",./tags")
"+set isk=33-34,36-38,42-90,92,94-95,97-125"
- (pack "+" (car "*Vi"))
- (path (cdr "*Vi")) )
- "X" ) )
+ (pack "+" (car "*Ed"))
+ (path (cdr "*Ed")) ) ) )
+
+(de em ("X" C)
+ (_ed
+ '("@lib/eled.l" "@lib/eedit.l")
+ (call "emacsclient"
+ "-c"
+ (pack "+" (car "*Ed"))
+ (path (cdr "*Ed")) ) ) )
(de ld ()
- (and "*Vi" (load (cdr "*Vi"))) )
+ (and "*Ed" (load (cdr "*Ed"))) )
# Single-Stepping
(de _dbg (Lst)
diff --git a/lib/eedit.l b/lib/eedit.l
@@ -0,0 +1,130 @@
+# 12nov12abu
+# (c) Software Lab. Alexander Burger
+
+# "*F" "*Lst" "*X" "*K"
+
+#{
+
+* Emacs Server
+
+** Start the Emacs server you want to use for PicoLisp editing with
+server-name 'server', only then it will be automatically recognized by
+the calls to emacsclient. Example shellscript 'emacsd' for starting
+emacs as daemon (make it executable):
+
+ ,------------------------------------------------
+ | -rwxr-xr-x 1 me users 83 12. Nov 12:27 emacsd
+ `------------------------------------------------
+
+,-----------------------------------------------
+| #!/bin/sh
+|
+| exec emacs --daemon=server -l ~/my/home/emacs/init.el
+`-----------------------------------------------
+
+If there is no Emacs server running, or none with server-name
+'server', the call to emacsclient will start a new server and open an
+emacsclient for this server.
+
+* Customize Emacs:
+
+** Make Emacs revert the edit-buffers without querying
+(see http://www.gnu.org/software/emacs/manual/html_node/elisp/Reverting.html)
+
+,--------------------------------------------------------------------
+| You can customize how revert-buffer does its work by setting the
+| variables described in the rest of this section.
+|
+| — User Option: revert-without-query
+|
+| This variable holds a list of files that should be reverted without
+| query. The value is a list of regular expressions.
+`--------------------------------------------------------------------
+
+Use a regexp like this, replacing 'my/home/directory/' with the path
+to your home directory:
+
+,-------------------------------
+| my/home/directory/\.pil/tmp/.+
+`-------------------------------
+
+** Make Emacs save the edited buffer on exit without querying
+
+Do not exit with "C-x #" (server-edit) but with "C-x C-c" or "C-u C-x
+C-c":
+
+,---------------------------------------------------------------------
+| (save-buffers-kill-terminal &optional ARG)
+|
+| Offer to save each buffer, then kill the current connection.
+| If the current frame has no client, kill Emacs itself.
+|
+| With prefix ARG, silently save all file-visiting buffers, then kill.
+|
+| If emacsclient was started with a list of filenames to edit, then
+| only these files will be asked to be saved.
+`---------------------------------------------------------------------
+
+}#
+
+
+(de edit @
+ (let *Dbg NIL
+ (setq "*F" (tmp '"edit.l"))
+ (catch NIL
+ ("edit" (rest)) ) ) )
+
+(de "edit" ("Lst")
+ (let "N" 1
+ (loop
+ (out "*F"
+ (setq "*Lst"
+ (make
+ (for "S" "Lst"
+ ("loc" (printsp "S"))
+ ("loc" (val "S"))
+ (pretty (val "S"))
+ (prinl)
+ (for "X" (sort (getl "S"))
+ ("loc" "X")
+ (space 3)
+ (if (atom "X")
+ (println "X" T)
+ (printsp (cdr "X"))
+ (pretty (setq "X" (car "X")) -3)
+ (cond
+ ((type "X")
+ (prin " # ")
+ (print @) )
+ ((>= 799999 "X" 700000)
+ (prin " # " (datStr "X")) ) )
+ (prinl) ) )
+ (prinl)
+ (println '(********))
+ (prinl) ) ) ) )
+ (call 'emacsclient
+ "-a" ""
+ "-c"
+ (pack "+" "N")
+ "*F" )
+ (apply ==== "*Lst")
+ (in "*F"
+ (while (and (setq "*X" (read)) (atom "*X"))
+ (def "*X" (read))
+ (until (= '(********) (setq "*K" (read)))
+ (def "*X" "*K" (read)) ) ) )
+ (====)
+ (NIL "*X" (throw))
+ (T (=0 (car "*X")))
+ (setq "N" (car "*X"))
+ ("edit" (conc (cdr "*X") "Lst")) ) ) )
+
+(de "loc" ("X" "Lst")
+ (cond
+ ((memq "X" "Lst"))
+ ((and (str? "X") (not (memq "X" (made))))
+ (link "X") )
+ ((pair "X")
+ (push '"Lst" "X")
+ ("loc" (car "X") "Lst")
+ ("loc" (cdr "X") "Lst") ) ) )
diff --git a/lib/el/picolisp-wiki-mode.el b/lib/el/picolisp-wiki-mode.el
@@ -0,0 +1,1177 @@
+;;; picolisp-wiki-mode.el --- Emacs Major mode for PicoLisp-Wiki formatted text files
+
+;; Copyright (C) 2012 Thorsten Jolitz <tjolitz@gmail.com>
+
+;; Author: Thorsten Jolitz <tjolitz@gmail.com>
+;; Maintainer: Thorsten Jolitz <tjolitz@gmail.com>
+;; Created: September 01, 2012
+;; Version: 1.0
+;; Keywords: PicoLisp, wiki
+;; URL: http://picolisp.com/5000/!wiki?home
+
+;; 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, 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 Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
+
+;;; Commentary:
+
+;; picolisp-wiki-mode is a major mode for editing text files for
+;; PicoLisp-Wiki in GNU Emacs. picolisp-wiki-mode is free software,
+;; licensed under the GNU GPL.
+
+;;; Dependencies:
+
+;; picolisp-wiki-mode requires easymenu, a standard package since GNU Emacs
+;; 19 and XEmacs 19, which provides a uniform interface for creating
+;; menus in GNU Emacs and XEmacs.
+
+;;; Installation:
+
+;; Make sure to place `picolisp-wiki-mode.el` somewhere in the
+;; load-path and add the following lines to your `.emacs` file to
+;; associate picolisp-wiki-mode with `.text` files:
+
+ (autoload 'picolisp-wiki-mode "picolisp-wiki-mode"
+ "Major mode for editing Picolisp-Wiki files" t)
+ (setq auto-mode-alist
+ ;; (cons '("\\.text" . picolisp-wiki-mode) auto-mode-alist))
+ (cons '("\\.plw" . picolisp-wiki-mode) auto-mode-alist))
+
+;; There is no consensus on an official file extension so change `.text` to
+;; `.plw`, `.lw`, `.lwik`, or whatever you call your picolisp-wiki files.
+
+;;; Customization:
+
+;; Although no configuration is *necessary* there are a few things
+;; that can be customized. The `M-x customize-mode` command
+;; provides an interface to all of the possible customizations.
+
+;; Usage:
+
+;; Keybindings for inserting are grouped by prefixes based on their
+;; function. For example, commands inserting links and lists begin
+;; with `C-c C-l`, those inserting floating content with `C-c C-f`,
+;; all other inserting commands with `C-c C-c`. The commands in each
+;; group are described below. You can obtain a list of all keybindings
+;; by pressing `C-c C-h`.
+
+;; ;; Element insertion
+;; "\C-c\C-l n" Insert Internal Link
+;; "\C-c\C-l x" Insert External Link
+;; "\C-c\C-l u" Insert Unordered List
+;; "\C-c\C-l o" Insert Ordered List
+;; "\C-c\C-l i" Insert List Item
+;; "\C-c\C-f l" Insert Left-Floating-Content
+;; "\C-c\C-f n" Insert Non-Floating Content
+;; "\C-c\C-f r" Insert Right-Floating-Content
+;; "\C-c\C-c k" Insert Line Breaks
+;; "\C-c\C-c 1" Insert Header 1
+;; "\C-c\C-c 2" Insert Header 2
+;; "\C-c\C-c 3" Insert Header 3
+;; "\C-c\C-c 4" Insert Header 4
+;; "\C-c\C-c 5" Insert Header 5
+;; "\C-c\C-c 6" Insert Header 6
+;; "\C-c\C-c b" Insert Bold
+;; "\C-c\C-c i" Insert Italic
+;; "\C-c\C-c u" Insert Underlined
+;; "\C-c\C-c p" Insert Pre Block
+;; "\C-c\C-c c" Insert Comment
+;; "\C-c\C-c -" Insert Horizontal Rule (hr)
+;; ;; Visibility cycling
+;; "<tab>" Picolisp Wiki Cycle
+;; "<S-iso-lefttab>" Picolisp Wiki Shifttab
+;; ;; Header navigation
+;; "C-M-n" Outline Next Visible Heading
+;; "C-M-p" Outline Previous Visible Heading
+;; "C-M-f" Outline Forward Same Level
+;; "C-M-b" Outline Backward Same Level
+;; "C-M-u" Outline Up Heading
+
+;; Many of the commands described above behave differently depending on
+;; whether Transient Mark mode is enabled or not. When it makes sense,
+;; if Transient Mark mode is on and a region is active, the command
+;; applies to the text in the region (e.g., `C-c C-c b` makes the region
+;; bold). For users who prefer to work outside of Transient Mark mode,
+;; in Emacs 22 it can be enabled temporarily by pressing `C-SPC C-SPC`.
+;;
+;; picolisp-wiki-mode supports outline-minor-mode as well as
+;; org-mode-style visibility cycling for PicoLisp-Wikli-style headers.
+;; There are two types of visibility cycling: Pressing `S-TAB` cycles
+;; globally between the table of contents view (headers only), outline
+;; view (top-level headers only), and the full document view. Pressing
+;; `TAB` while the point is at a header will cycle through levels of
+;; visibility for the subtree: completely folded, visible children,
+;; and fully visible.
+
+;; * Outline Navigation:
+;;
+;; Navigation between headings is possible using `outline-mode'.
+;; Use `C-M-n` and `C-M-p` to move between the next and previous
+;; visible headings. Similarly, `C-M-f` and `C-M-b` move to the
+;; next and previous visible headings at the same level as the one
+;; at the point. Finally, `C-M-u` will move up to a lower-level
+;; (more inclusive) visible heading.
+;;
+;; FIXME: different headers levels are not yet recognized by the outine
+;; commands.
+
+
+;;; Acknowledgments:
+
+;; picolisp-wiki-mode is based on markdown.el (available from ELPA).
+;; It has benefited greatly from the efforts of the following people:
+;;
+;; * Thorsten Jolitz <tjolitz [AT] gmail [DOT] com>
+;; * Doug Lewan <dougl [@] shubertticketing [DOT] com>
+;;; Bugs:
+
+;; picolisp-wiki-mode is developed and tested primarily using GNU
+;; Emacs 24, compatibility with earlier Emacsen is no priority. For
+;; bugs and todo's, see the HISTORY.org file in the github-repo
+;; (https://github.com/tj64/picolisp-wiki-mode).
+;;
+;; If you find any bugs in picolisp-wiki-mode, please construct a test case
+;; or a patch and email me at <tjolitz@gmail.com>.
+
+;;; History:
+
+;; picolisp-wiki-mode was written and is maintained by Thorsten
+;; Joltiz. The first version (0.9) was released on Sept 01, 2012. For
+;; further information see the HISTORY.org file in the github-repo
+;; (https://github.com/tj64/picolisp-wiki-mode).
+
+
+;;; Code:
+
+(require 'easymenu)
+(require 'outline)
+(require 'cl)
+
+;;; Constants =================================================================
+
+(defconst picolisp-wiki-mode-version "0.9"
+ "Picolisp-Wiki mode version number.")
+
+;;; Customizable variables ====================================================
+
+(defvar picolisp-wiki-mode-hook nil
+ "Hook runs when Picolisp-Wiki mode is loaded.")
+
+(defgroup picolisp-wiki nil
+ "Major mode for editing text files in Picolisp-Wiki format."
+ :prefix "picolisp-wiki-"
+ :group 'wp
+ :link '(url-link "http://picolisp.com/5000/!wiki?homef"))
+
+
+(defcustom picolisp-wiki-hr-string "------------------------------------"
+ "String to use for horizonal rules."
+ :group 'picolisp-wiki
+ :type 'string)
+
+(defcustom picolisp-wiki-uri-types
+ '("acap" "cid" "data" "dav" "fax" "file" "ftp" "gopher" "http" "https"
+ "imap" "ldap" "mailto" "mid" "modem" "news" "nfs" "nntp" "pop" "prospero"
+ "rtsp" "service" "sip" "tel" "telnet" "tip" "urn" "vemmi" "wais")
+ "Link types for syntax highlighting of URIs."
+ :group 'picolisp-wiki
+ :type 'list)
+
+
+(defcustom picolisp-wiki-link-space-sub-char
+ "_"
+ "Character to use instead of spaces when mapping wiki links to filenames."
+ :group 'picolisp-wiki
+ :type 'string)
+
+
+;;; Font lock =================================================================
+
+(require 'font-lock)
+
+(defvar picolisp-wiki-starting-brace-face
+ 'picolisp-wiki-starting-brace-face
+ "Face name to use for starting braces.")
+
+(defvar picolisp-wiki-closing-brace-face
+ 'picolisp-wiki-closing-brace-face
+ "Face name to use for closing braces.")
+
+(defvar picolisp-wiki-line-break-face 'picolisp-wiki-line-break-face
+ "Face name to use for line breaks.")
+
+(defvar picolisp-wiki-italic-face 'picolisp-wiki-italic-face
+ "Face name to use for italic text.")
+
+(defvar picolisp-wiki-bold-face 'picolisp-wiki-bold-face
+ "Face name to use for bold text.")
+
+(defvar picolisp-wiki-underlined-face 'picolisp-wiki-underlined-face
+ "Face name to use for underlined text.")
+
+(defvar picolisp-wiki-header-face 'picolisp-wiki-header-face
+ "Face name to use as a base for headers.")
+
+(defvar picolisp-wiki-header-face-1 'picolisp-wiki-header-face-1
+ "Face name to use for level-1 headers.")
+
+(defvar picolisp-wiki-header-face-2 'picolisp-wiki-header-face-2
+ "Face name to use for level-2 headers.")
+
+(defvar picolisp-wiki-header-face-3 'picolisp-wiki-header-face-3
+ "Face name to use for level-3 headers.")
+
+(defvar picolisp-wiki-header-face-4 'picolisp-wiki-header-face-4
+ "Face name to use for level-4 headers.")
+
+(defvar picolisp-wiki-header-face-5 'picolisp-wiki-header-face-5
+ "Face name to use for level-5 headers.")
+
+(defvar picolisp-wiki-header-face-6 'picolisp-wiki-header-face-6
+ "Face name to use for level-6 headers.")
+
+(defvar picolisp-wiki-list-item-face 'picolisp-wiki-list-item-face
+ "Face name to use for list markers.")
+
+(defvar picolisp-wiki-left-floating-content-face
+ 'picolisp-wiki-left-floating-content-face
+ "Face name to use for left floating content.")
+
+(defvar picolisp-wiki-non-floating-content-face
+ 'picolisp-wiki-non-floating-content-face
+ "Face name to use for non floating content.")
+
+(defvar picolisp-wiki-right-floating-content-face
+ 'picolisp-wiki-right-floating-content-face
+ "Face name to use for right floating content.")
+
+(defvar picolisp-wiki-pre-face 'picolisp-wiki-pre-face
+ "Face name to use for preformatted text.")
+
+(defvar picolisp-wiki-link-label-face 'picolisp-wiki-link-label-face
+ "Face name to use for link labels.")
+
+(defvar picolisp-wiki-url-face 'picolisp-wiki-url-face
+ "Face name to use for URLs.")
+
+(defvar picolisp-wiki-link-title-face 'picolisp-wiki-link-title-face
+ "Face name to use for reference link titles.")
+
+(defvar picolisp-wiki-comment-face 'picolisp-wiki-comment-face
+ "Face name to use for HTML comments.")
+
+
+
+;; FACE definitions
+
+(defgroup picolisp-wiki-faces nil
+ "Faces used in Picolisp-Wiki Mode"
+ :group 'picolisp-wiki
+ :group 'faces)
+
+(defface picolisp-wiki-hr-face
+ '((t (:inherit font-lock-comment-delimiter-face)))
+ "Face for starting braces."
+ :group 'picolisp-wiki-faces)
+
+(defface picolisp-wiki-starting-brace-face
+ '((t (:inherit font-lock-comment-delimiter-face)))
+ "Face for starting braces."
+ :group 'picolisp-wiki-faces)
+
+(defface picolisp-wiki-closing-brace-face
+ '((t (:inherit font-lock-comment-delimiter-face)))
+ "Face for closing braces."
+ :group 'picolisp-wiki-faces)
+
+(defface picolisp-wiki-italic-face
+ '((t (:inherit font-lock-negation-char-face :slant italic)))
+ "Face for italic text."
+ :group 'picolisp-wiki-faces)
+
+(defface picolisp-wiki-bold-face
+ '((t (:inherit font-lock-negation-char-face :weight bold)))
+ "Face for bold text."
+ :group 'picolisp-wiki-faces)
+
+(defface picolisp-wiki-underlined-face
+ '((t (:inherit font-lock-negation-char-face :underline t)))
+ "Face for underlined text."
+ :group 'picolisp-wiki-faces)
+
+(defface picolisp-wiki-line-break-face
+ '((t (:inherit font-lock-warning-face)))
+ "Face for underlined text."
+ :group 'picolisp-wiki-faces)
+
+(defface picolisp-wiki-header-face
+ '((t (:inherit font-lock-function-name-face :weight bold)))
+ "Base face for headers."
+ :group 'picolisp-wiki-faces)
+
+(defface picolisp-wiki-header-face-1
+ '((t (:inherit picolisp-wiki-header-face)))
+ "Face for level-1 headers."
+ :group 'picolisp-wiki-faces)
+
+(defface picolisp-wiki-header-face-2
+ '((t (:inherit picolisp-wiki-header-face)))
+ "Face for level-2 headers."
+ :group 'picolisp-wiki-faces)
+
+(defface picolisp-wiki-header-face-3
+ '((t (:inherit picolisp-wiki-header-face)))
+ "Face for level-3 headers."
+ :group 'picolisp-wiki-faces)
+
+(defface picolisp-wiki-header-face-4
+ '((t (:inherit picolisp-wiki-header-face)))
+ "Face for level-4 headers."
+ :group 'picolisp-wiki-faces)
+
+(defface picolisp-wiki-header-face-5
+ '((t (:inherit picolisp-wiki-header-face)))
+ "Face for level-5 headers."
+ :group 'picolisp-wiki-faces)
+
+(defface picolisp-wiki-header-face-6
+ '((t (:inherit picolisp-wiki-header-face)))
+ "Face for level-6 headers."
+ :group 'picolisp-wiki-faces)
+
+(defface picolisp-wiki-list-item-face
+ '((t (:inherit font-lock-string-face)))
+ "Face for list item markers."
+ :group 'picolisp-wiki-faces)
+
+(defface picolisp-wiki-pre-face
+ '((t (:inherit font-lock-constant-face)))
+ "Face for preformatted text."
+ :group 'picolisp-wiki-faces)
+
+(defface picolisp-wiki-internal-link-face
+ '((t (:inherit font-lock-keyword-face)))
+ "Face for internal links."
+ :group 'picolisp-wiki-faces)
+
+(defface picolisp-wiki-external-link-face
+ '((t (:inherit font-lock-keyword-face)))
+ "Face for external links."
+ :group 'picolisp-wiki-faces)
+
+(defface picolisp-wiki-url-face
+ '((t (:inherit font-lock-string-face)))
+ "Face for URLs."
+ :group 'picolisp-wiki-faces)
+
+(defface picolisp-wiki-link-label-face
+ '((t (:inherit font-lock-keyword-face)))
+ "Face for reference link titles."
+ :group 'picolisp-wiki-faces)
+
+(defface picolisp-wiki-comment-face
+ '((t (:inherit font-lock-comment-face)))
+ "Face for HTML comments."
+ :group 'picolisp-wiki-faces)
+
+
+;; REGEXP
+;; FIXME consider linebreaks in pattern
+
+;; [start] regexp by Doug Lewan (Newsgroups: gmane.emacs.help)
+
+(defconst picolisp-wiki-regex-plain-text
+ (concat "\\([[:space:]]*[^}]+\\)[[:space:]]*" ; Matches "123$%^ Чебурашка &*(0-="
+ )
+ "Regular expression defining what 'plain text' is.")
+
+(defconst picolisp-wiki-regex-bold-text
+ (concat "\\(!{\\)"
+ picolisp-wiki-regex-plain-text
+ "\\(}\\)")
+ "Regular expression defining what 'bold text' is.")
+
+(defconst picolisp-wiki-regex-text
+ (concat "\\("
+ picolisp-wiki-regex-plain-text
+ "\\|"
+ picolisp-wiki-regex-bold-text
+ "\\)")
+ "Regular expression defining what 'text'.
+Text is a mix of plain text and bold text.")
+
+(defconst picolisp-wiki-regex-list-item-text
+ (concat "\\(-{\\)"
+ picolisp-wiki-regex-text "+"
+ "\\(}\\)")
+ "Regular expression defining what a 'list item' is.")
+
+;; [end] regexp by Doug Lewan (Newsgroups: gmane.emacs.help)
+
+;; [start] testcode for regexp by Doug Lewan
+
+;; ;;
+;; ;; Sunny day test code
+;; ;;
+;; (defconst test-plain-text (list "foo"
+;; "foo bar "
+;; " foo bar baz bat"
+;; " --- 123$%^ Чебурашка &*(0-= --- "))
+;; (defconst test-bold-text (mapcar (lambda (text)
+;; (concat "!{" text "}"))
+;; test-plain-text))
+;; (defconst test-list-item-text (mapcar (lambda (list-text)
+;; (concat "-{" list-text "}"))
+;; (append test-plain-text test-bold-text)))
+
+;; (mapc (lambda (test-spec)
+;; (let ((re (car test-spec))
+;; (test-data (cdr test-spec)))
+;; (mapc (lambda (item)
+;; (if (string-match re item)
+;; (message "PASS -- [[%s]] matches [[%s]]" re item)
+;; (message "FAIL -- [[%s]] DIDN'T match [[%s]]" re item))
+;; (sit-for 1))
+;; test-data)))
+;; (list (cons picolisp-wiki-regex-plain-text test-plain-text)
+;; (cons picolisp-wiki-regex-bold-text test-bold-text)
+;; (cons picolisp-wiki-regex-list-item-text test-list-item-text)))
+
+;; [end] testcode testcode for regexp by Doug Lewan
+
+(defconst picolisp-wiki-regex-internal-link
+ "\\(={\\)\\([^ ]+\\)\\( \\)\\(.*\\)\\(}\\)"
+ "Regular expression for an internal link.")
+
+(defconst picolisp-wiki-regex-external-link
+ "\\(\\^{\\)\\([^ ]+\\)\\( \\)\\(.*\\)\\(}\\)"
+ "Regular expression for an external link.")
+
+(defconst picolisp-wiki-regex-comment
+ "\\(#{\\)\\([
+]*[^}]+\\)\\(}\\)"
+ "Regular expression for an external link.")
+
+(defconst picolisp-wiki-regex-header-1
+ "\\(1{\\)\\([
+]*[^}]+\\)\\(}\\)"
+ "Regular expression for level 1 headers.")
+
+(defconst picolisp-wiki-regex-header-2
+ "\\(2{\\)\\([
+]*[^}]+\\)\\(}\\)"
+ "Regular expression for level 2 headers.")
+
+(defconst picolisp-wiki-regex-header-3
+ "\\(3{\\)\\([
+]*[^}]+\\)\\(}\\)"
+ "Regular expression for level 3 headers.")
+
+(defconst picolisp-wiki-regex-header-4
+ "\\(4{\\)\\([
+]*[^}]+\\)\\(}\\)"
+ "Regular expression for level 4 headers.")
+
+(defconst picolisp-wiki-regex-header-5
+ "\\(5{\\)\\([
+]*[^}]+\\)\\(}\\)"
+ "Regular expression for level 5 headers.")
+
+(defconst picolisp-wiki-regex-header-6
+ "\\(6{\\)\\([
+]*[^}]+\\)\\(}\\)"
+ "Regular expression for level 6 headers.")
+
+(defconst picolisp-wiki-regex-hr
+ "\\(--\\)+\\(---\\)*$"
+ "Regular expression for matching Picolisp-Wiki horizontal rules.")
+
+(defconst picolisp-wiki-regex-left-floating-content
+ "\\(<{\\)\\([
+]*[^}]+\\)\\(}\\)"
+ "Regular expression for matching left-floating-content.")
+
+(defconst picolisp-wiki-regex-non-floating-content
+ "\\(@{\\)\\([
+]*[^}]+\\)\\(}\\)"
+ "Regular expression for matching non-floating-content.")
+
+(defconst picolisp-wiki-regex-right-floating-content
+ "\\(>{\\)\\([
+]*[^}]+\\)\\(}\\)"
+ "Regular expression for matching right-floating-content.")
+
+(defconst picolisp-wiki-regex-pre-block
+ "\\(:{\\)\\([
+]*[^}]+\\)\\(}\\)"
+
+;; "\\(:{\\)\\([ \t\n]*[^}]+\\)\\(}\\)"
+
+;; "\\(:{\\)\\([
+;; ][^}]+\\)\\(}\\)"
+ "Regular expression for matching preformatted text sections.")
+
+;; (defconst picolisp-wiki-regex-unordered-list
+;; "\\(^[\\t ]*\\*{\\)\\([ ]*[
+;; ]+\\)\\(-{.*}[
+;; ]+\\)\\{1,\\}\\(}\\)"
+;; "Regular expression for matching unordered list markers.")
+
+;; (defconst picolisp-wiki-regex-ordered-list
+;; "\\(^[\\t ]*\\+{\\)\\([ ]*[
+;; ]+\\)\\(-{.*}[
+;; ]+\\)\\{1,\\}\\(}\\)"
+;; "Regular expression for matching ordered list markers.")
+
+;; (defconst picolisp-wiki-regex-unordered-list-start
+;; "\\(^\\*{\\)\\([ \t\n]*$\\)"
+;; "Regular expression for matching the start of an unordered list.")
+
+;; (defconst picolisp-wiki-regex-ordered-list-start
+;; "\\(^\\+{\\)\\([ \t\n]*$\\)"
+;; "Regular expression for matching the start of an ordered list.")
+
+(defconst picolisp-wiki-regex-starting-brace
+ (concat "\\(\\*\\|\\+\\|-\\|&\\|/\\|_\\|\\^\\|"
+ "<\\|>\\|@\\|!\\|=\\|:\\|#\\|1\\|2\\|"
+ "3\\|4\\|5\\|6\\)\\({\\)")
+ "Regular expression for matching a starting brace.")
+
+(defconst picolisp-wiki-regex-closing-brace
+ "\\([^\\]\\)\\(}\\)"
+ "Regular expression for matching a closing brace.")
+
+(defconst picolisp-wiki-regex-list-item
+ "\\(-{\\)\\([
+]*[^}]+\\)\\(}\\)"
+ "Regular expression for matching a list item.")
+
+(defconst picolisp-wiki-regex-bold
+ "\\(!{\\)\\([
+]*[^}]+\\)\\(}\\)"
+ "Regular expression for matching bold text.")
+
+(defconst picolisp-wiki-regex-italic
+ "\\(/{\\)\\([
+]*[^}]+\\)\\(}\\)"
+ "Regular expression for matching italic text.")
+
+(defconst picolisp-wiki-regex-underlined
+ "\\(_{\\)\\([
+]*[^}]+\\)\\(}\\)"
+ "Regular expression for matching underlined text.")
+
+(defconst picolisp-wiki-regex-line-break
+ "\\(&{\\)\\([-]?[0-9]\\)\\(}\\)"
+ "Regular expression for matching line breaks.")
+
+(defconst picolisp-wiki-regex-wiki-link
+ "\\[\\[\\([^]|]+\\)\\(|\\([^]]+\\)\\)?\\]\\]"
+ "Regular expression for matching wiki links.
+This matches typical bracketed [[WikiLinks]] as well as 'aliased'
+wiki links of the form [[PageName|link text]]. In this regular
+expression, #1 matches the page name and #3 matches the link
+text.")
+
+(defconst picolisp-wiki-regex-uri
+ (concat
+ "\\(" (mapconcat 'identity picolisp-wiki-uri-types "\\|")
+ "\\):[^]\t\n\r<>,;() ]+")
+ "Regular expression for matching inline URIs.")
+
+(defconst picolisp-wiki-regex-angle-uri
+ (concat
+ "\\(<\\)\\("
+ (mapconcat 'identity picolisp-wiki-uri-types "\\|")
+ "\\):[^]\t\n\r<>,;()]+\\(>\\)")
+ "Regular expression for matching inline URIs in angle brackets.")
+
+(defconst picolisp-wiki-regex-email
+ "<\\(\\sw\\|\\s_\\|\\s.\\)+@\\(\\sw\\|\\s_\\|\\s.\\)+>"
+ "Regular expression for matching inline email addresses.")
+
+
+
+;; Keywords
+
+(defvar picolisp-wiki-mode-font-lock-keywords-basic
+ (list
+ (cons picolisp-wiki-regex-header-1 '(2 picolisp-wiki-header-face-1))
+ (cons picolisp-wiki-regex-header-2 '(2 picolisp-wiki-header-face-2))
+ (cons picolisp-wiki-regex-header-3 '(2 picolisp-wiki-header-face-3))
+ (cons picolisp-wiki-regex-header-4 '(2 picolisp-wiki-header-face-4))
+ (cons picolisp-wiki-regex-header-5 '(2 picolisp-wiki-header-face-5))
+ (cons picolisp-wiki-regex-header-6 '(2 picolisp-wiki-header-face-6))
+ (cons picolisp-wiki-regex-starting-brace 'picolisp-wiki-starting-brace-face)
+ (cons picolisp-wiki-regex-closing-brace '(2 picolisp-wiki-closing-brace-face))
+ (cons picolisp-wiki-regex-pre-block '(2 picolisp-wiki-pre-face))
+ (cons picolisp-wiki-regex-hr '(2 picolisp-wiki-hr-face))
+ (cons picolisp-wiki-regex-line-break '(2 picolisp-wiki-line-break-face))
+ (cons picolisp-wiki-regex-comment '(2 picolisp-wiki-comment-face))
+ (cons picolisp-wiki-regex-angle-uri '(2 picolisp-wiki-url-face))
+ (cons picolisp-wiki-regex-uri '(2 picolisp-wiki-url-face))
+ (cons picolisp-wiki-regex-email '(2 picolisp-wiki-url-face))
+ (cons picolisp-wiki-regex-left-floating-content
+ '(2 picolisp-wiki-left-floating-content-fact))
+ (cons picolisp-wiki-regex-non-floating-content
+ '(2 picolisp-wiki-non-floating-content-fact))
+ (cons picolisp-wiki-regex-right-floating-content
+ '(2 picolisp-wiki-right-floating-content-fact))
+ (cons picolisp-wiki-regex-email '(2 picolisp-wiki-url-face))
+ ;; changed from picolisp-wiki-regex-list-item
+ (cons picolisp-wiki-regex-list-item '(2 picolisp-wiki-list-item-face))
+ ;; (cons picolisp-wiki-regex-list-item-text 'picolisp-wiki-list-item-face)
+ (cons picolisp-wiki-regex-internal-link
+ '((2 picolisp-wiki-url-face t)
+ (4 picolisp-wiki-internal-link-face t)))
+ (cons picolisp-wiki-regex-external-link
+ '((2 picolisp-wiki-url-face t)
+ (4 picolisp-wiki-external-link-face t)))
+ (cons picolisp-wiki-regex-bold '(2 picolisp-wiki-bold-face))
+ ;; (cons picolisp-wiki-regex-bold-text 'picolisp-wiki-bold-face)
+ (cons picolisp-wiki-regex-italic '(2 picolisp-wiki-italic-face))
+ (cons picolisp-wiki-regex-underlined '(2 picolisp-wiki-underlined-face))
+ )
+ "Syntax highlighting for Picolisp-Wiki files.")
+
+(defvar picolisp-wiki-mode-font-lock-keywords
+ (append picolisp-wiki-mode-font-lock-keywords-basic)
+ "Default highlighting expressions for Picolisp-Wiki mode.")
+
+
+
+;;; Syntax Table ==============================================================
+
+(defvar picolisp-wiki-mode-syntax-table
+ (let ((picolisp-wiki-mode-syntax-table (make-syntax-table)))
+ (modify-syntax-entry ?\" "w" picolisp-wiki-mode-syntax-table)
+ picolisp-wiki-mode-syntax-table)
+ "Syntax table for `picolisp-wiki-mode'.")
+
+
+
+;;; Element Insertion =========================================================
+
+(defun picolisp-wiki-wrap-or-insert (s1 s2 &optional beg-newline-p)
+ "Insert the strings S1 and S2.
+If Transient Mark mode is on and a region is active, wrap the strings S1
+and S2 around the region."
+ (if (and transient-mark-mode mark-active)
+ (let ((a (region-beginning)) (b (region-end)))
+ (goto-char a)
+ (insert s1)
+ (goto-char (+ b (length s1)))
+ (insert s2))
+ (if (not beg-newline-p)
+ (insert s1 s2)
+ (end-of-line)
+ (newline 2)
+ (insert s1 s2))))
+
+(defun picolisp-wiki-insert-hr ()
+ "Insert a horizonal rule using `picolisp-wiki-hr-string'."
+ (interactive)
+ ;; Leading blank line
+ (when (and (>= (point) (+ (point-min) 2))
+ (not (looking-back "\n\n" 2)))
+ (insert "\n"))
+ ;; Insert custom HR string
+ (insert (concat picolisp-wiki-hr-string "\n"))
+ ;; Following blank line
+ (backward-char)
+ (unless (looking-at "\n\n")
+ (insert "\n")))
+
+(defun picolisp-wiki-insert-bold ()
+ "Insert markup for a bold word or phrase.
+If Transient Mark mode is on and a region is active, it is made bold."
+ (interactive)
+ (picolisp-wiki-wrap-or-insert "!{" "}")
+ (backward-char 1))
+
+(defun picolisp-wiki-insert-italic ()
+ "Insert markup for an italic word or phrase.
+If Transient Mark mode is on and a region is active, it is made italic."
+ (interactive)
+ (picolisp-wiki-wrap-or-insert "/{" "}")
+ (backward-char 1))
+
+(defun picolisp-wiki-insert-underlined ()
+ "Insert markup for an underlined word or phrase.
+If Transient Mark mode is on and a region is active, it is underlined."
+ (interactive)
+ (picolisp-wiki-wrap-or-insert "_{" "}")
+ (backward-char 1))
+
+
+(defun picolisp-wiki-insert-pre-block ()
+ "Insert markup for a pre-formatted block.
+If Transient Mark mode is on and a region is active, it is marked
+as inline code."
+ (interactive)
+ (picolisp-wiki-wrap-or-insert ":{" "}")
+ (backward-char 1))
+
+(defun picolisp-wiki-insert-comment ()
+ "Insert markup for an comment.
+If Transient Mark mode is on and a region is active, it is marked
+as inline code."
+ (interactive)
+ (picolisp-wiki-wrap-or-insert "#{" "}")
+ (backward-char 1))
+
+
+(defun picolisp-wiki-insert-internal-link ()
+ "Insert an internal link.
+If Transient Mark mode is on and a region is active, it is used
+as the link text."
+ (interactive)
+ (picolisp-wiki-wrap-or-insert "={" "}")
+ (backward-char 1))
+
+(defun picolisp-wiki-insert-external-link ()
+ "Insert an external link.
+If Transient Mark mode is on and a region is active, it is used
+as the link text."
+ (interactive)
+ (picolisp-wiki-wrap-or-insert "^{" "}")
+ (backward-char 1))
+
+
+(defun picolisp-wiki-insert-left-floating-content ()
+ "Insert an inline image tag of the form <{content}.
+If Transient Mark mode is on and a region is active, it is used
+as the alt text of the image."
+ (interactive)
+ (picolisp-wiki-wrap-or-insert "<{" "}")
+ (backward-char 1))
+
+(defun picolisp-wiki-insert-non-floating-content ()
+ "Insert an inline image tag of the form @{content}.
+If Transient Mark mode is on and a region is active, it is used
+as the alt text of the image."
+ (interactive)
+ (picolisp-wiki-wrap-or-insert "@{" "}")
+ (backward-char 1))
+
+(defun picolisp-wiki-insert-right-floating-content ()
+ "Insert an inline image tag of the form >{content}.
+If Transient Mark mode is on and a region is active, it is used
+as the alt text of the image."
+ (interactive)
+ (picolisp-wiki-wrap-or-insert ">{" "}")
+ (backward-char 1))
+
+
+(defun picolisp-wiki-insert-line-breaks (n)
+ "Insert line-breaks. With no prefix argument, insert 1
+line-break. With prefix N, insert N line-breaks. With prefix N,
+insert N line-breaks. With negative prefix -N, insert N
+line-breaks and clear float style."
+ (interactive "p")
+ (unless n ; Test to see if n is defined
+ (setq n 1)) ; Default to level 1 header
+ (insert
+ (format "&{%d}" n )))
+
+
+(defun picolisp-wiki-insert-unordered-list ()
+ "Insert an unordered list.
+If Transient Mark mode is on and a region is active, it is wrapped in an unordered list (the region should only contain list-items)."
+ (interactive)
+ (end-of-line)
+ (newline)
+ (insert "*{")
+ (newline)
+ (insert " -{}")
+ (newline)
+ (insert "}")
+ (newline)
+ (search-backward "-{" nil t 1)
+ (forward-char 2))
+
+
+(defun picolisp-wiki-insert-ordered-list ()
+ "Insert an ordered list.
+If Transient Mark mode is on and a region is active, it is
+wrapped in an ordered list (the region should only contain
+list-items)."
+ (interactive)
+ (end-of-line)
+ (newline)
+ (insert "+{")
+ (newline)
+ (insert " -{}")
+ (newline)
+ (insert "}")
+ (newline)
+ (search-backward "-{" nil t 1)
+ (forward-char 2))
+
+
+;; FIXME consider escaped braces '\{'and '\}' inside list items
+(defun picolisp-wiki--inside-list-item-p (&optional second-trial-p)
+ "Return t if inside list-item, nil otherwise.
+This function takes care of the (common) case when there is one
+nested markup inside the list item, e.g. a link or a bold text,
+and point is inside the nested markup braces."
+ (save-excursion
+ (let ((pt (point)))
+ (search-backward "{" nil t 1)
+ (backward-char)
+ (if (not (looking-at "-{"))
+ (if (and
+ (not second-trial-p)
+ (looking-at
+ (concat "\\(\\*\\|\\+\\|&\\|/\\|_\\|\\^\\|"
+ "<\\|>\\|@\\|!\\|=\\|:\\|#\\)\\({\\)")))
+ (picolisp-wiki--inside-list-item-p 'SECOND-TRIAL-P)
+ nil)
+ (and
+ (if second-trial-p
+ (search-forward-regexp "}[^}]*}" nil t 1)
+ (search-forward "}" nil t 1))
+ (setq item-end (point))
+ (> item-end pt))))))
+
+(defun picolisp-wiki-insert-list-item ()
+ "Insert a list-item.
+If Transient Mark mode is on and a region is active, it becomes the text of a list item."
+ (interactive)
+ (if (not (picolisp-wiki--inside-list-item-p))
+ (progn
+ (picolisp-wiki-wrap-or-insert "-{" "}")
+ (backward-char 1))
+ (end-of-line)
+ (newline)
+ (insert " -{}")
+ (backward-char 1)
+ ))
+
+
+(defun picolisp-wiki-insert-header-1 ()
+ "Insert a first level picolisp-wiki-style header.
+If Transient Mark mode is on and a region is active, it is used
+as the header text."
+ (interactive)
+ (picolisp-wiki-insert-header 1))
+
+(defun picolisp-wiki-insert-header-2 ()
+ "Insert a second level picolisp-wiki-style header.
+If Transient Mark mode is on and a region is active, it is used
+as the header text."
+ (interactive)
+ (picolisp-wiki-insert-header 2))
+
+(defun picolisp-wiki-insert-header-3 ()
+ "Insert a third level picolisp-wiki-style header.
+If Transient Mark mode is on and a region is active, it is used
+as the header text."
+ (interactive)
+ (picolisp-wiki-insert-header 3))
+
+(defun picolisp-wiki-insert-header-4 ()
+ "Insert a fourth level picolisp-wiki-style header.
+If Transient Mark mode is on and a region is active, it is used
+as the header text."
+ (interactive)
+ (picolisp-wiki-insert-header 4))
+
+(defun picolisp-wiki-insert-header-5 ()
+ "Insert a fifth level picolisp-wiki-style header.
+If Transient Mark mode is on and a region is active, it is used
+as the header text."
+ (interactive)
+ (picolisp-wiki-insert-header 5))
+
+(defun picolisp-wiki-insert-header-6 ()
+ "Insert a sixth level picolisp-wiki-style header.
+If Transient Mark mode is on and a region is active, it is used
+as the header text."
+ (interactive)
+ (picolisp-wiki-insert-header 6))
+
+(defun picolisp-wiki-insert-header (n)
+ "Insert an picolisp-wiki-style header.
+With no prefix argument, insert a level-1 header. With prefix N,
+insert a level-N header. If Transient Mark mode is on and the
+region is active, it is used as the header text."
+ (interactive "p")
+ (unless n ; Test to see if n is defined
+ (setq n 1)) ; Default to level 1 header
+ (picolisp-wiki-wrap-or-insert
+ (concat (number-to-string n) "{") "}" 'BEG-NEWLINE-P)
+ (backward-char 1))
+
+
+
+;;; Keymap ====================================================================
+
+(defvar picolisp-wiki-mode-map
+ (let ((map (make-keymap)))
+ ;; Element insertion
+ (define-key map "\C-c\C-ln" 'picolisp-wiki-insert-internal-link)
+ (define-key map "\C-c\C-lx" 'picolisp-wiki-insert-external-link)
+ (define-key map "\C-c\C-lu" 'picolisp-wiki-insert-unordered-list)
+ (define-key map "\C-c\C-lo" 'picolisp-wiki-insert-ordered-list)
+ (define-key map "\C-c\C-li" 'picolisp-wiki-insert-list-item)
+ (define-key map "\C-c\C-fl" 'picolisp-wiki-insert-left-floating-content)
+ (define-key map "\C-c\C-fn" 'picolisp-wiki-insert-non-floating-content)
+ (define-key map "\C-c\C-fr" 'picolisp-wiki-insert-right-floating-content)
+ (define-key map "\C-c\C-ck" 'picolisp-wiki-insert-line-breaks)
+ (define-key map "\C-c\C-c1" 'picolisp-wiki-insert-header-1)
+ (define-key map "\C-c\C-c2" 'picolisp-wiki-insert-header-2)
+ (define-key map "\C-c\C-c3" 'picolisp-wiki-insert-header-3)
+ (define-key map "\C-c\C-c4" 'picolisp-wiki-insert-header-4)
+ (define-key map "\C-c\C-c5" 'picolisp-wiki-insert-header-5)
+ (define-key map "\C-c\C-c6" 'picolisp-wiki-insert-header-6)
+ (define-key map "\C-c\C-cb" 'picolisp-wiki-insert-bold)
+ (define-key map "\C-c\C-ci" 'picolisp-wiki-insert-italic)
+ (define-key map "\C-c\C-cu" 'picolisp-wiki-insert-underlined)
+ (define-key map "\C-c\C-cp" 'picolisp-wiki-insert-pre-block)
+ (define-key map "\C-c\C-cc" 'picolisp-wiki-insert-comment)
+ (define-key map "\C-c\C-c-" 'picolisp-wiki-insert-hr)
+ ;; Visibility cycling
+ (define-key map (kbd "<tab>") 'picolisp-wiki-cycle)
+ (define-key map (kbd "<S-iso-lefttab>") 'picolisp-wiki-shifttab)
+ ;; Header navigation
+ (define-key map (kbd "C-M-n") 'outline-next-visible-heading)
+ (define-key map (kbd "C-M-p") 'outline-previous-visible-heading)
+ (define-key map (kbd "C-M-f") 'outline-forward-same-level)
+ (define-key map (kbd "C-M-b") 'outline-backward-same-level)
+ (define-key map (kbd "C-M-u") 'outline-up-heading)
+ ;; Picolisp-Wiki functions
+ ;; (define-key map "\C-c\C-cm" 'picolisp-wiki)
+ ;; (define-key map "\C-c\C-cp" 'picolisp-wiki-preview)
+ ;; (define-key map "\C-c\C-ce" 'picolisp-wiki-export)
+ ;; (define-key map "\C-c\C-cv" 'picolisp-wiki-export-and-view)
+ map)
+ "Keymap for Picolisp-Wiki major mode.")
+
+
+
+
+
+;;; Menu ==================================================================
+
+(easy-menu-define picolisp-wiki-mode-menu picolisp-wiki-mode-map
+ "Menu for Picolisp-Wiki mode"
+ '("Picolisp-Wiki"
+ ("Show/Hide"
+ ["Cycle visibility" picolisp-wiki-cycle (outline-on-heading-p)]
+ ["Cycle global visibility" picolisp-wiki-shifttab])
+ "---"
+ ("Headers"
+ ["First level" picolisp-wiki-insert-header-1]
+ ["Second level" picolisp-wiki-insert-header-2]
+ ["Third level" picolisp-wiki-insert-header-3]
+ ["Fourth level" picolisp-wiki-insert-header-4]
+ ["Fifth level" picolisp-wiki-insert-header-5]
+ ["Sixth level" picolisp-wiki-insert-header-6])
+ "---"
+ ["Bold" picolisp-wiki-insert-bold]
+ ["Italic" picolisp-wiki-insert-italic]
+ ["Underlined" picolisp-wiki-insert-underlined]
+ ["Preformatted" picolisp-wiki-insert-pre-block]
+ ["Comment" picolisp-wiki-insert-comment]
+ ["Insert horizontal rule" picolisp-wiki-insert-hr]
+ "---"
+ ["Insert internal link" picolisp-wiki-insert-internal-link]
+ ["Insert external link" picolisp-wiki-insert-external-link]
+ "---"
+ ["Insert left-floating content" picolisp-wiki-insert-left-floating-content]
+ ["Insert non-floating content" picolisp-wiki-insert-non-floating-content]
+ ["Insert right-floating content" picolisp-wiki-insert-right-floating-content]
+ "---"
+ ["Insert unordered list" picolisp-wiki-insert-unordered-list]
+ ["Insert ordered list" picolisp-wiki-insert-ordered-list]
+ "---"
+ ["Version" picolisp-wiki-show-version]
+ ))
+
+
+
+;;; Outline ===================================================================
+
+;; The following visibility cycling code was taken from org-mode
+;; by Carsten Dominik and adapted for picolisp-wiki-mode.
+
+(defvar picolisp-wiki-cycle-global-status 1)
+(defvar picolisp-wiki-cycle-subtree-status nil)
+
+;; Based on org-end-of-subtree from org.el
+(defun picolisp-wiki-end-of-subtree (&optional invisible-OK)
+ "Move to the end of the current subtree.
+Only visible heading lines are considered, unless INVISIBLE-OK is
+non-nil."
+ (outline-back-to-heading invisible-OK)
+ (let ((first t)
+ (level (funcall outline-level)))
+ (while (and (not (eobp))
+ (or first (> (funcall outline-level) level)))
+ (setq first nil)
+ (outline-next-heading))
+ (if (memq (preceding-char) '(?\n ?\^M))
+ (progn
+ ;; Go to end of line before heading
+ (forward-char -1)
+ (if (memq (preceding-char) '(?\n ?\^M))
+ ;; leave blank line before heading
+ (forward-char -1)))))
+ (point))
+
+;; Based on org-cycle from org.el.
+(defun picolisp-wiki-cycle (&optional arg)
+ "Visibility cycling for Picolisp-Wiki mode.
+If ARG is t, perform global visibility cycling. If the point is
+at an picolisp-wiki-style header, cycle visibility of the
+corresponding subtree. Otherwise, insert a tab using
+`indent-relative'."
+ (interactive "P")
+ (cond
+ ((eq arg t) ;; Global cycling
+ (cond
+ ((and (eq last-command this-command)
+ (eq picolisp-wiki-cycle-global-status 2))
+ ;; Move from overview to contents
+ (hide-sublevels 1)
+ (message "CONTENTS")
+ (setq picolisp-wiki-cycle-global-status 3))
+
+ ((and (eq last-command this-command)
+ (eq picolisp-wiki-cycle-global-status 3))
+ ;; Move from contents to all
+ (show-all)
+ (message "SHOW ALL")
+ (setq picolisp-wiki-cycle-global-status 1))
+
+ (t
+ ;; Defaults to overview
+ (hide-body)
+ (message "OVERVIEW")
+ (setq picolisp-wiki-cycle-global-status 2))))
+
+ ((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) eoh eol eos)
+ ;; Determine boundaries
+ (save-excursion
+ (outline-back-to-heading)
+ (save-excursion
+ (beginning-of-line 2)
+ (while (and (not (eobp)) ;; this is like `next-line'
+ (get-char-property (1- (point)) 'invisible))
+ (beginning-of-line 2)) (setq eol (point)))
+ (outline-end-of-heading) (setq eoh (point))
+ (picolisp-wiki-end-of-subtree t)
+ (skip-chars-forward " \t\n")
+ (beginning-of-line 1) ; in case this is an item
+ (setq eos (1- (point))))
+ ;; Find out what to do next and set `this-command'
+ (cond
+ ((= eos eoh)
+ ;; Nothing is hidden behind this heading
+ (message "EMPTY ENTRY")
+ (setq picolisp-wiki-cycle-subtree-status nil))
+ ((>= eol eos)
+ ;; Entire subtree is hidden in one line: open it
+ (show-entry)
+ (show-children)
+ (message "CHILDREN")
+ (setq picolisp-wiki-cycle-subtree-status 'children))
+ ((and (eq last-command this-command)
+ (eq picolisp-wiki-cycle-subtree-status 'children))
+ ;; We just showed the children, now show everything.
+ (show-subtree)
+ (message "SUBTREE")
+ (setq picolisp-wiki-cycle-subtree-status 'subtree))
+ (t
+ ;; Default action: hide the subtree.
+ (hide-subtree)
+ (message "FOLDED")
+ (setq picolisp-wiki-cycle-subtree-status 'folded)))))
+
+ (t
+ (indent-for-tab-command))))
+
+;; Based on org-shifttab from org.el.
+(defun picolisp-wiki-shifttab ()
+ "Global visibility cycling.
+Calls `picolisp-wiki-cycle' with argument t."
+ (interactive)
+ (picolisp-wiki-cycle t))
+
+
+;;; Miscellaneous =============================================================
+
+(defun picolisp-wiki-line-number-at-pos (&optional pos)
+ "Return (narrowed) buffer line number at position POS.
+If POS is nil, use current buffer location.
+This is an exact copy of `line-number-at-pos' for use in emacs21."
+ (let ((opoint (or pos (point))) start)
+ (save-excursion
+ (goto-char (point-min))
+ (setq start (point))
+ (goto-char opoint)
+ (forward-line 0)
+ (1+ (count-lines start (point))))))
+
+(defun picolisp-wiki-nobreak-p ()
+ "Return nil if it is acceptable to break the current line at the point."
+ ;; inside in square brackets (e.g., link anchor text)
+ (looking-back "\\[[^]]*"))
+
+
+
+;;; Mode definition ==========================================================
+
+(defun picolisp-wiki-show-version ()
+ "Show the version number in the minibuffer."
+ (interactive)
+ (message "picolisp-wiki-mode, version %s" picolisp-wiki-mode-version))
+
+;;;###autoload
+(define-derived-mode picolisp-wiki-mode text-mode "PicoLisp-Wiki"
+ "Major mode for editing PicoLisp-Wiki files."
+ ;; Natural Picolisp-Wiki tab width
+ (setq tab-width 4)
+ ;; Comments
+ (make-local-variable 'comment-start)
+ (setq comment-start "#{")
+ (make-local-variable 'comment-end)
+ (setq comment-end "}")
+ ;; (make-local-variable 'comment-start-skip)
+ ;; (setq comment-start-skip "#{ \t}*")
+ (make-local-variable 'comment-column)
+ (setq comment-column 0)
+ ;; Font lock.
+ (set (make-local-variable 'font-lock-defaults)
+ '(picolisp-wiki-mode-font-lock-keywords))
+ (set (make-local-variable 'font-lock-multiline) t)
+ ;; Make filling work with lists (unordered, ordered, and definition)
+ ;; (set (make-local-variable 'paragraph-start)
+ ;; "\f\\|[ \t]*$\\|^[ \t]*[*+-] \\|^[ \t*][0-9]+\\.\\|^[ \t]*: ")
+ ;; Outline mode
+ (make-local-variable 'outline-regexp)
+ (setq outline-regexp "^[ \t]*[0-9]{")
+ ;; Cause use of ellipses for invisible text.
+ (add-to-invisibility-spec '(outline . t)))
+
+
+(provide 'picolisp-wiki-mode)
+
+;;; picolisp-wiki-mode.el ends here
diff --git a/lib/el/picolisp.el b/lib/el/picolisp.el
@@ -1,23 +1,30 @@
;;;;;; picolisp-mode: Major mode to edit picoLisp.
-;;;;;; Version: 1.2
+;;;;;; Version: 1.3
;;; Copyright (c) 2009, Guillermo R. Palavecino
+;;; Copyright (c) 2011, 2012 Thorsten Jolitz
;; This file is NOT part of GNU emacs.
;;;; Credits:
;; It's based on GNU emacs' lisp-mode and scheme-mode.
;; Some bits were taken from paredit.el
+;; Two functions were copied from Xah Lee (http://xahlee.org/)
;;
;;;; Contact:
-;; For comments, bug reports, questions, etc, you can contact me via IRC
-;; to the user named grpala (or armadillo) on irc.freenode.net in the
-;; #picolisp channel or via email to the author's nickname at gmail.com
-;;
+;; For comments, bug reports, questions, etc, you can contact the
+;; first author via IRC to the user named grpala (or armadillo) on
+;; irc.freenode.net in the #picolisp channel or via email to the
+;; author's nickname at gmail.com
+;;
+;; Or contact the second author and curent maintainer via email:
+;; t <lastname in lowercase letters> AT gmail DOT com
+;;
;;;; License:
;; This work is released under the GPL 2 or (at your option) any later
;; version.
+
(require 'lisp-mode)
(defcustom picolisp-parsep t
@@ -88,6 +95,7 @@
(defvar picolisp-mode-abbrev-table nil)
(define-abbrev-table 'picolisp-mode-abbrev-table ())
+
(defun picolisp-mode-variables ()
(set-syntax-table picolisp-mode-syntax-table)
;;(setq local-abbrev-table picolisp-mode-abbrev-table)
@@ -163,6 +171,14 @@
(defvar picolisp-mode-map
(let ((map (make-sparse-keymap "Picolisp")))
(set-keymap-parent map lisp-mode-shared-map)
+
+ ;; more convenient than "C-ck"
+ (define-key map "\C-c\C-v" 'picolisp-edit-K)
+ ;; more convenient than "C-cq"
+ (define-key map "\C-c\C-c" 'picolisp-edit-Q)
+ ;; not necesary: picolisp-edit-Q exits on last undo
+ ;; (define-key map "\C-q" '(save-buffers-kill-terminal 1))
+
(define-key map [menu-bar picolisp] (cons "Picolisp" map))
(define-key map [run-picolisp] '("Run Inferior Picolisp" . run-picolisp))
(define-key map [uncomment-region]
@@ -224,6 +240,7 @@ See `run-hooks'."
:type 'hook
:group 'picolisp )
+
(defconst picolisp-font-lock-keywords-1
(eval-when-compile
(list
@@ -265,6 +282,7 @@ See `run-hooks'."
'(1 font-lock-preprocessor-face) ) ) )
"Subdued expressions to highlight in Picolisp modes." )
+
(defconst picolisp-font-lock-keywords-2
(append picolisp-font-lock-keywords-1
(eval-when-compile
@@ -376,6 +394,8 @@ See `run-hooks'."
(if (eq (char-after) ?\() 2 0) ) )
+;; Indentation functions
+
;; Copied from lisp-indent-line,
;; because Picolisp doesn't care about how many comment chars you use.
(defun picolisp-indent-line (&optional whole-exp)
@@ -475,6 +495,7 @@ rigidly along with this one."
(goto-char (car (cdr state)))
(+ 1 (current-column)) ) ) )
+
;;; This is to space closing parens when they close a previous line.
(defun picolisp-parensep ()
(save-excursion
@@ -514,6 +535,9 @@ rigidly along with this one."
(backward-char)
(when picolisp-parsep
(insert " ") ) ) ) ) ) )
+
+
+;; Parser functions
(defun picolisp-current-parse-state ()
"Return parse state of point from beginning of defun."
@@ -555,6 +579,178 @@ Assumes that `picolisp-in-string-p' is false, so that it need not handle
(add-to-list 'auto-mode-alist '("\\.l$" . picolisp-mode))
+
+;; The following two functions implement the K and Q (macro)
+;; functionality used in Vi while editing a buffer opened from the
+;; PicoLisp command-line with the 'edit' function.
+
+(defun picolisp-edit-K ()
+ "Write symbol at point with line number in last line of edit-buffer.
+
+If the symbol is a transient symbol, write it with double-quotes,
+otherwise as unquoted word. The output-format is:
+
+\(<line-number> <symbol>\)
+ e.g.
+\(50 edit\)
+\(56 \"edit\"\)
+
+when point is on the edit or \(transient\) \"edit\" symbol in the
+PicoLisp sourcefile edit.l and `picolisp-edit-K' is called (the
+line-numbers may be different in your version of edit.l).
+
+Recognition of transient symbols works by getting the
+text-property 'face' at point and checking if it is equal to
+'font-lock-string-face'. Thus, this function works correctly only
+if the edit-buffer is in an Emacs major-mode that fontifies
+strings with 'font-lock-string-face' \(like `picolisp-mode'
+does\)."
+
+ (interactive)
+ (save-excursion
+ (save-restriction
+ (widen)
+ (unless (mark 'FORCE)
+ (forward-word)
+ (forward-word -1)
+ (mark-word))
+ (let* ((thing (thing-at-point 'word))
+ (unit (get-selection-or-unit 'word))
+ (line (line-number-at-pos))
+ (transient-p
+ (string-equal (get-text-property (point) 'face)
+ "font-lock-string-face"))
+ (k-list nil))
+ (setq k-list (list line
+ (if transient-p
+ (elt unit 0)
+ (make-symbol (elt unit 0)))))
+ (message "K-list: %S transient: %S" k-list transient-p)
+ (goto-char (max-char))
+ (newline)
+ (insert (format "%S" k-list))
+ (save-buffers-kill-terminal 1)))))
+
+
+(defun picolisp-edit-Q ()
+ "Write '(0)' in last line of PicoLisp edit-buffer."
+ (interactive)
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (max-char))
+ (newline)
+ (insert "(0)")
+ (save-buffers-kill-terminal 1))))
+
+
+;; The following two functions have been written by Xah Lee and copied
+;; from: http://ergoemacs.org/emacs/elisp_get-selection-or-unit.html
+
+(defun get-selection-or-unit (unit)
+ "Return the string and boundary of text selection or UNIT under cursor.
+
+If `region-active-p' is true, then the region is the unit. Else,
+it depends on the UNIT. See `unit-at-cursor' for detail about
+UNIT.
+
+Returns a vector [text a b], where text is the string and a and b
+are its boundary.
+
+Example usage:
+ (setq bds (get-selection-or-unit 'line))
+ (setq inputstr (elt bds 0) p1 (elt bds 1) p2 (elt bds 2) )"
+ (interactive)
+
+ (let ((p1 (region-beginning)) (p2 (region-end)))
+ (if (region-active-p)
+ (vector (buffer-substring-no-properties p1 p2) p1 p2 )
+ (unit-at-cursor unit) ) ) )
+
+;; This function get-selection-or-unit gets you the text selection if
+;; there's one. If not, it calls unit-at-cursor. unit-at-cursor
+
+(defun unit-at-cursor (unit)
+ "Return the string and boundary of UNIT under cursor.
+
+Returns a vector [text a b], where text is the string and a and b are its boundary.
+
+UNIT can be:
+• 'word — sequence of 0 to 9, A to Z, a to z, and hyphen.
+• 'glyphs — sequence of visible glyphs. Useful for file name, URL, …, that doesn't have spaces in it.
+• 'line — delimited by “\\n”.
+• 'block — delimited by “\\n\\n” or beginning/end of buffer.
+• 'buffer — whole buffer. (respects `narrow-to-region')
+• a vector [beginRegex endRegex] — The elements are regex strings used to determine the beginning/end of boundary chars. They are passed to `skip-chars-backward' and `skip-chars-forward'. For example, if you want paren as delimiter, use [\"^(\" \"^)\"]
+
+Example usage:
+ (setq bds (unit-at-cursor 'line))
+ (setq myText (elt bds 0) p1 (elt bds 1) p2 (elt bds 2) )
+
+This function is similar to `thing-at-point' and `bounds-of-thing-at-point'.
+The main differences are:
+• this function returns the text and the 2 boundaries as a vector in one shot.
+• 'line always returns the line without end of line character, avoiding inconsistency when the line is at end of buffer.
+• 'word does not depend on syntax table.
+• 'block does not depend on syntax table."
+ (let (p1 p2)
+ (save-excursion
+ (cond
+ ( (eq unit 'word)
+ (let ((wordcharset "-A-Za-zÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖØÙÚÛÜÝÞßàáâãäåæçèéêëìíîïðñòóôõöøùúûüýþÿ"))
+ (skip-chars-backward wordcharset)
+ (setq p1 (point))
+ (skip-chars-forward wordcharset)
+ (setq p2 (point)))
+ )
+
+ ( (eq unit 'glyphs)
+ (progn
+ (skip-chars-backward "[:graph:]")
+ (setq p1 (point))
+ (skip-chars-forward "[:graph:]")
+ (setq p2 (point)))
+ )
+
+ ( (eq unit 'buffer)
+ (progn
+ (setq p1 (point-min))
+ (setq p2 (point-max))
+ )
+ )
+
+ ((eq unit 'line)
+ (progn
+ (setq p1 (line-beginning-position))
+ (setq p2 (line-end-position))))
+ ((eq unit 'block)
+ (progn
+ (if (re-search-backward "\n\n" nil t)
+ (progn (forward-char 2)
+ (setq p1 (point) ) )
+ (setq p1 (line-beginning-position) )
+ )
+
+ (if (re-search-forward "\n\n" nil t)
+ (progn (backward-char)
+ (setq p2 (point) ))
+ (setq p2 (line-end-position) ) ) ))
+
+ ((vectorp unit)
+ (let (p0)
+ (setq p0 (point))
+ (skip-chars-backward (elt unit 0))
+ (setq p1 (point))
+ (goto-char p0)
+ (skip-chars-forward (elt unit 1))
+ (setq p2 (point))))
+ ) )
+
+ (vector (buffer-substring-no-properties p1 p2) p1 p2 )
+ ) )
+
+
+;; tsm-mode
(require 'tsm)
(ignore-errors
diff --git a/lib/eled.l b/lib/eled.l
@@ -0,0 +1,630 @@
+# 19nov12tj
+# Authors Alexander Burger, Thorsten Jolitz
+# (c) Software Lab. Alexander Burger
+
+# Line editor
+# emacs-mode
+
+(mapc undef
+ '(*Led fkey revise) )
+
+(setq
+ "Line" NIL # Holds current input line
+ "LPos" 1 # Position in line (1 .. length)
+ "HPos" 1 # Position in history
+ "UndoLine" NIL # Undo
+ "UndoPos" 0
+ "Line1" NIL # Initial line
+ "Insert" T # Insert mode flag
+ "FKey" NIL # Function key bindings
+ "Clip" NIL # Cut/Copy/Paste buffer
+ "Item" NIL # Item to find
+ "Found" NIL # Find stack
+ "Mark" NIL # Position of mark
+ "Register" NIL # (Named) storage for text-snippets
+ "Complete" NIL # Input completion
+
+ "HistMax" 1000 # History limit
+
+ "History" # History of input lines
+ (in (pack "+" (pil "history"))
+ (ctl NIL
+ (make (until (eof) (link (line T)))) ) )
+ "Hist0" "History" )
+
+
+# Switch Crtl-C off
+
+# Ctrl-C is actually not defined as a special key, but as a signal
+# handler. Depending on the 'stty' settings, a SIGINT signal is sent to
+# the process when Ctrl-C is pressed.
+#
+# If this is not desired, then some other key (or none) must be set in the
+# terminal settings. This can be done with
+#
+# $ stty intr ^A
+#
+# or, from inside PicoLisp
+#
+# (call 'stty "intr" "^A")
+
+(raw T)
+(call 'stty "intr" "")
+
+# Basic editing routine
+(de chgLine (L N)
+ (let (D (length "Line") Tsm)
+ (for (P (dec "LPos") (>= P 1) (dec P)) # To start of old line
+ (unless
+ (and
+ *Tsm
+ (= "\"" (get "Line" P))
+ (skipQ "LPos" P "Line") )
+ (prin "^H") ) )
+ (for (P . C) (setq "Line" L) # Output new line
+ (cond
+ ((> " " C)
+ (dec 'D)
+ (prin "_") )
+ ((or (not *Tsm) (<> "\"" C) (escQ P L))
+ (dec 'D)
+ (prin C) )
+ (T
+ (prin
+ (and Tsm (cdr *Tsm))
+ (unless (skipQ N P L)
+ (dec 'D)
+ C )
+ (and (onOff Tsm) (car *Tsm)) ) ) ) )
+ (and Tsm (prin (cdr *Tsm)))
+ (space D) # Clear rest of old line
+ (do D (prin "^H"))
+ (setq "LPos" (inc (length L)))
+ (until (= N "LPos") # To new position
+ (unless
+ (and
+ *Tsm
+ (= "\"" (get "Line" "LPos"))
+ (skipQ N "LPos" "Line") )
+ (prin "^H") )
+ (dec '"LPos") ) )
+ (flush) )
+
+# Skipped double quote
+(de skipQ (N P L)
+ (nor
+ (>= (inc N) P (dec N))
+ (= "\"" (get L (dec P)))
+ (= "\"" (get L (inc P)))
+ (escQ P L) ) )
+
+# Escaped double quote
+(de escQ ()
+ (let Esc NIL
+ (for I (dec P)
+ ((if (= "\\" (get L I)) onOff off) Esc) ) ) )
+
+# Check for delimiter
+(de delim? (C)
+ (member C '`(chop '" ^I^J^M\"'()[]`~")) )
+
+# Move left
+(de lMove ()
+ (chgLine "Line" (max 1 (dec "LPos"))) )
+
+# Move to beginning
+(de bMove ()
+ (chgLine "Line" 1) )
+
+# Move right
+(de rMove ()
+ (chgLine "Line"
+ (if (>= "LPos" (length "Line"))
+ "LPos"
+ (inc "LPos") ) ) )
+
+# Move to end of line
+(de eMove ()
+ (chgLine "Line" (length "Line")) )
+
+# Move beyond end of line
+(de xMove ()
+ (chgLine "Line" (inc (length "Line"))) )
+
+# Move word left
+(de lWord ()
+ (use (N L)
+ (chgLine "Line"
+ (if (>= 1 (setq N "LPos"))
+ 1
+ (loop
+ (T (= 1 (dec 'N)) 1)
+ (setq L (nth "Line" (dec N)))
+ (T (and (delim? (car L)) (not (delim? (cadr L))))
+ N ) ) ) ) ) )
+
+# Move word right
+(de rWord ()
+ (use (M N L)
+ (setq M (length "Line"))
+ (chgLine "Line"
+ (if (<= M (setq N "LPos"))
+ M
+ (loop
+ (T (= M (inc 'N)) M)
+ (setq L (nth "Line" (dec N)))
+ (T (and (delim? (car L)) (not (delim? (cadr L))))
+ N ) ) ) ) ) )
+
+(de vi-rWord ()
+ (use (M N L)
+ (setq M (length "Line"))
+ (chgLine "Line"
+ (if (<= M (setq N "LPos"))
+ M
+ (loop
+ (T (= M (inc 'N)) M)
+ (setq L (nth "Line" (dec N)))
+ (T (and (delim? (car L)) (not (delim? (cadr L))))
+ N ) ) ) ) ) )
+
+# Match left parenthesis
+(de lPar ()
+ (let (N 1 I (dec "LPos"))
+ (loop
+ (T (=0 I))
+ (case (get "Line" I)
+ (")" (inc 'N))
+ ("(" (dec 'N)) )
+ (T (=0 N) (chgLine "Line" I))
+ (dec 'I) ) ) )
+
+# Match right parenthesis
+(de rPar ()
+ (let (N 1 I (inc "LPos"))
+ (loop
+ (T (> I (length "Line")))
+ (case (get "Line" I)
+ ("(" (inc 'N))
+ (")" (dec 'N)) )
+ (T (=0 N) (chgLine "Line" I))
+ (inc 'I) ) ) )
+
+# Clear to end of line
+(de clrEol ()
+ (let N (dec "LPos")
+ (if (=0 N)
+ (chgLine NIL 1)
+ (chgLine (head N "Line") N) ) ) )
+
+# Insert a char
+(de insChar (C)
+ (chgLine (insert "LPos" "Line" C) (inc "LPos")) )
+
+(de del1 (L)
+ (ifn (nth L "LPos")
+ L
+ (setq "Clip" (append "Clip" (list (get L "LPos"))))
+ (remove "LPos" L) ) )
+
+# Delete a char
+(de delChar ()
+ (use L
+ (off "Clip")
+ (chgLine
+ (setq L (del1 "Line"))
+ (max 1 (min "LPos" (length L))) ) ) )
+
+# Delete a word (F: with trailing blank)
+(de delWord (F)
+ (let L "Line"
+ (off "Clip")
+ (ifn (= "(" (get L "LPos"))
+ (while (and (nth L "LPos") (not (delim? (get L "LPos"))))
+ (setq L (del1 L)) )
+ (for (N 1 (and (setq L (del1 L)) (< 0 N)))
+ (case (get L "LPos")
+ ("(" (inc 'N))
+ (")" (dec 'N)) ) ) )
+ (and
+ F
+ (sp? (get L "LPos"))
+ (setq L (del1 L)) )
+ (chgLine L (max 1 (min "LPos" (length L)))) ) )
+
+# Replace char
+(de rplChar (C)
+ (chgLine
+ (insert "LPos" (remove "LPos" "Line") C)
+ "LPos" ) )
+
+# Undo mechanism
+(de doUndo ()
+ (setq "UndoLine" "Line" "UndoPos" "LPos") )
+
+# Paste clip
+(de doPaste ()
+ (if (= 1 "LPos")
+ (chgLine (append "Clip" "Line") 1)
+ (chgLine
+ (append
+ (head (dec "LPos") "Line")
+ "Clip"
+ (nth "Line" "LPos") )
+ (+ "LPos" (length "Clip") -1) ) ) )
+
+# Set history line
+(de setHist (N)
+ (chgLine
+ (if (=0 (setq "HPos" N))
+ "Line1"
+ (chop (get "History" "HPos")) )
+ 1 ) )
+
+# Searching
+(de ledSearch (L)
+ (let (H (nth "History" (inc "HPos")) S (find '((X) (match "Item" (chop X))) H))
+ (chgLine
+ (ifn S
+ (prog (beep) L)
+ (push '"Found" "HPos")
+ (inc '"HPos" (index S H))
+ (chop S) )
+ 1 ) ) )
+
+# TAB expansion
+(de expandTab ()
+ (let ("L" (head (dec "LPos") "Line") "S" "L")
+ (while (find "skipFun" "S")
+ (pop '"S") )
+ (ifn "S"
+ (prog
+ (off "Complete")
+ (do 3 (insChar " ")) )
+ (ifn
+ (default "Complete"
+ (let "N" (inc (length "S"))
+ (mapcar
+ '((X)
+ (setq X
+ (nth
+ (mapcan
+ '((C)
+ (if (or (= "\\" C) (delim? C))
+ (list "\\" C)
+ (cons C) ) )
+ (chop X) )
+ "N" ) )
+ (cons
+ (+ "LPos" (length X))
+ (append "L" X (nth "Line" "LPos")) ) )
+ ("tabFun" (pack "S")) ) ) )
+ (beep)
+ (chgLine (cdar "Complete") (caar "Complete"))
+ (rot "Complete") ) ) ) )
+
+# Insert mode
+(de insMode ("C")
+ (if (= "C" "^I")
+ (expandTab)
+ (off "Complete")
+ (case "C"
+ (("^H" "^?")
+ (when (> "LPos" 1)
+ (chgLine (remove (dec "LPos") "Line") (dec "LPos")) ) )
+ ## ("^V" (insChar (key)))
+
+ # 'M-<char>' (Meta or Alt) keymap, implemented with ESC prefix
+ ("^[" (and (key 500)
+ (case @
+ # forward-word
+ # TODO: emacs (goto end of word!)
+ ("f" (rWord))
+ # backward-word
+ ("b" (lWord))
+ # kill-word
+ ("d" (doUndo) (delWord T))
+ # toggle case of char
+ # TODO: capitalize/downcase/upcase word
+ ((or "c" "l")
+ (doUndo)
+ (rplChar
+ ((if
+ (low? (setq "C" (get "Line" "LPos")))
+ uppc lowc ) "C" ) )
+ (rMove) )
+ # forward-sexp
+ ("^f"
+ (case (get "Line" "LPos")
+ ("(" (rPar))
+ (T (beep)) ) )
+ # backward-sexp
+ ("^b"
+ (case (get "Line" "LPos")
+ (")" (lPar))
+ (T (beep)) ) )
+ # show present working directory (pwd)
+ ("^d" (prinl (pwd)) (quit))
+ # goto/find char
+ ("g"
+ (ifn (setq "C" (index (key) (nth "Line" (inc "LPos"))))
+ (beep)
+ (chgLine "Line" (+ "C" "LPos")) ) )
+ # accept input pattern for history search
+ ("^s"
+ (let "L" "Line"
+ (_getLine '("/") '((C) (= C "/")))
+ (unless (=T "Line")
+ (setq "Item" (append '(@) (cdr "Line") '(@)))
+ (ledSearch "L")
+ ## (off "Insert")
+ ) ) )
+ # search for next occurrence of pattern
+ # in history-search
+ ("s" (ledSearch "Line"))
+ # search for previous occurrence of pattern
+ # in history-search
+ ("r" (if "Found" (setHist (pop '"Found")) (beep))) ) ) )
+
+ # 'C-c' (Ctrl-c) keymap
+ ("^c" (and (key 1000)
+ (case @
+ # change directory
+ ("^d"
+ (prinl "[(pwd) " (pwd) "]")
+ (prin "(cd) ")
+ (cd (read)) (quit) )
+ # make directory (with parents)
+ ("+"
+ (prinl "[(pwd) " (pwd) "]")
+ (prin "(mkdir -p) ")
+ (call 'mkdir (read) "-p") (quit) )
+ # call shell-command with arguments
+ (("^c" "!")
+ (prin "[cmd -args] ")
+ (eval
+ (append '(call)
+ (mapcar pack
+ (split (chop (line T)) " " ) ) ) )
+ (quit) ) ) ) )
+
+ # 'C-u (Ctrl-u) keymap (functions with arguments)
+ ("^u" (and (key 1000)
+ (case @
+ # list directory files
+ # (including those starting with .)
+ ("^x" (and (key 500)
+ (case @
+ ("^d"
+ (printsp (dir (pwd) T))
+ (prinl) (quit) ) ) ) ) ) ) )
+
+ # 'C-x' (Ctrl-x) keymap
+ ("^x" (and (key 500)
+ (case @
+ # undo
+ ("u"
+ (let ("L" "Line" "P" "LPos")
+ (chgLine "UndoLine" "UndoPos")
+ (setq "UndoLine" "L" "UndoPos" "P") ) )
+ # list directory files
+ ("^d" (printsp (dir (pwd))) (prinl) (quit))
+ # find-file (with ZILE)
+ ("f"
+ (use X
+ (prinl "[(pwd) " (pwd) "]")
+ (prin "(zile) ")
+ (call 'zile (read)) (quit) ) )
+ # edit file (with EMACSCLIENT)
+ ## ("^f" (edit ) )
+ ) ) )
+ ## (case @
+ ## ((call 'test "-f" X)
+ ## (call 'zile X) (quit) )
+ ## ((call 'test "-d" X)
+ ## (prinl "Can't open directory") (quit) )
+ ## (T (case @
+ ## ((call 'test "-d" (dirname X))
+ ## (chdir (dirname X)
+ ## (out (basename X)
+ ## (call -zile X) )
+ ## (quit) ) )
+ ## (T (call 'mkdir (dirname X) "-p")
+ ## (chdir (dirname X)
+ ## (out (basename X)) ) ) ) ) ) ) ) ) ) )
+
+ # 'C-h' (Ctrl-h) keymap (info/help functionality)
+ ("^h" (and (key 500)
+ (case @
+ # display current contents of
+ # kill-ring (cut buffer)
+ ("r" (prinl) (println "Clip")) ) ) )
+
+ # 'C-v' (Ctrl-v) keymap
+ ## ("^v" (and (key 500)
+ ## (case @
+ ## # display current contents of
+ ## # kill-ring (cut buffer)
+ ## ("r" (prinl) (println "Clip")) ) ) )
+
+ # undo
+ ("^_" (let ("L" "Line" "P" "LPos")
+ (chgLine "UndoLine" "UndoPos")
+ (setq "UndoLine" "L" "UndoPos" "P") ) )
+ # move-end-of-line
+ ("^e" (eMove))
+ # move-beginning-of-line
+ ("^a" (bMove))
+ # kill-line
+ ("^k" (doUndo) (clrEol))
+ # backward-char
+ ("^b" (lMove))
+ # forward-char
+ ("^f" (and (= "LPos" (length "Line"))(xMove))(rMove))
+ # next-line
+ ("^n" (unless (=0 "HPos") (setHist (dec "HPos"))))
+ # previous-line
+ ("^p" (when (< "HPos" (length "History")) (setHist (inc "HPos"))))
+ # yank
+ ("^y" (doUndo) (doPaste))
+ # delete-char
+ ("^D" (doUndo) (delChar))
+ # self-insertion
+ (T
+ (when (= "C" ")")
+ (chgLine "Line" (prog1 "LPos" (lPar) (wait 200))) )
+ (insChar "C") ) ) ) )
+
+# Command mode
+## (de cmdMode ("C")
+## (case "C"
+## ("g" (prinl) (println "Clip"))
+## ("$" (eMove))
+## ("%"
+## (case (get "Line" "LPos")
+## (")" (lPar))
+## ("(" (rPar))
+## (T (beep)) ) )
+## ("/"
+## (let "L" "Line"
+## (_getLine '("/") '((C) (= C "/")))
+## (unless (=T "Line")
+## (setq "Item" (append '(@) (cdr "Line") '(@)))
+## (ledSearch "L")
+## (off "Insert") ) ) )
+## ("0" (bMove))
+## ("A" (doUndo) (xMove) (on "Insert"))
+## ("a" (doUndo) ((if (= "LPos" (length "Line")) xMove rMove)) (on "Insert"))
+## ("b" (lWord))
+## ("c" (doUndo) (delWord NIL) (on "Insert"))
+## ("C" (doUndo) (clrEol) (xMove) (on "Insert"))
+## ("d" (doUndo) (delWord T))
+## ("D" (doUndo) (clrEol))
+## ("f"
+## (ifn (setq "C" (index (key) (nth "Line" (inc "LPos"))))
+## (beep)
+## (chgLine "Line" (+ "C" "LPos")) ) )
+## ("h" (lMove))
+## ("i" (doUndo) (on "Insert"))
+## ("I" (doUndo) (bMove) (on "Insert"))
+## ("j" (unless (=0 "HPos") (setHist (dec "HPos"))))
+## ("k" (when (< "HPos" (length "History")) (setHist (inc "HPos"))))
+## ("l" (rMove))
+## ("n" (ledSearch "Line"))
+## ("N" (if "Found" (setHist (pop '"Found")) (beep)))
+## ("p" (doUndo) ((if (= "LPos" (length "Line")) xMove rMove)) (doPaste))
+## ("P" (doUndo) (doPaste))
+## ("r" (ifn "Line" (beep) (doUndo) (rplChar (key))))
+## ("s" (doUndo) (delChar) (on "Insert"))
+## ("S" (doUndo) (chgLine NIL 1) (on "Insert"))
+## ("U" (setHist "HPos"))
+## ("u"
+## (let ("L" "Line" "P" "LPos")
+## (chgLine "UndoLine" "UndoPos")
+## (setq "UndoLine" "L" "UndoPos" "P") ) )
+## ("w" (rWord))
+## ("x" (doUndo) (delChar))
+## ("X" (lMove) (doUndo) (delChar))
+## ("~"
+## (doUndo)
+## (rplChar
+## ((if (low? (setq "C" (get "Line" "LPos"))) uppc lowc) "C") )
+## (rMove) )
+## (T (beep)) ) )
+
+# Get a line from console
+(de _getLine ("L" "skipFun")
+ (use "C"
+ (chgLine "L" (inc (length "L")))
+ (on "Insert")
+ (until
+ (member
+ (setq "C" (let *Dbg "*Dbg" (key)))
+ '("^J" "^M") )
+ (case "C"
+ (NIL (bye))
+ ## ("^D" (prinl) (bye))
+ ("^Q" (prinl) (bye))
+ ## ("^X" (prin (cdr *Tsm)) (prinl) (quit)) )
+ ("^G" (prin (cdr *Tsm)) (prinl) (quit)) )
+ ((if "Insert" insMode insMode) "C") ) ) ) # only insert mode for emacs
+ ## ((if "Insert" insMode cmdMode) "C") ) ) )
+
+# Function keys
+(de fkey (Key . Prg)
+ (setq "FKey"
+ (cond
+ ((not Key) "FKey")
+ ((not Prg) (delete (assoc Key "FKey") "FKey"))
+ ((assoc Key "FKey")
+ (cons (cons Key Prg) (delete @ "FKey")) )
+ (T (cons (cons Key Prg) "FKey")) ) ) )
+
+# Main editing functions
+(de _led ("Line1" "tabFun" "skipFun")
+ (default "tabFun"
+ '((S)
+ (conc
+ (filter '((X) (pre? S (sym X))) (all))
+ (let P (rot (split (chop S) "/"))
+ (setq
+ S (pack (car P))
+ P (and (cdr P) (pack (glue "/" @) "/")) )
+ (extract
+ '((X)
+ (and (pre? S X) (pack P X)) )
+ (dir P T) ) ) ) ) )
+ (setq "LPos" 1 "HPos" 0)
+ (_getLine "Line1" (or "skipFun" delim?))
+ (prinl (cdr *Tsm)) )
+
+(de revise ("X" "tabFun" "skipFun")
+ (let ("*Dbg" *Dbg *Dbg NIL)
+ (_led (chop "X") "tabFun" "skipFun")
+ (pack "Line") ) )
+
+(de saveHistory ()
+ (in (pack "+" (pil "history"))
+ (ctl T
+ (let (Old (make (until (eof) (link (line T)))) New "History" N "HistMax")
+ (out (pil "history")
+ (while (and New (n== New "Hist0"))
+ (prinl (pop 'New))
+ (dec 'N) )
+ (setq "Hist0" "History")
+ (do N
+ (NIL Old)
+ (prinl (pop 'Old)) ) ) ) ) ) )
+
+# Enable line editing
+(de *Led
+ (let ("*Dbg" *Dbg *Dbg NIL)
+ (push1 '*Bye '(saveHistory))
+ (push1 '*Fork '(del '(saveHistory) '*Bye))
+ (_led)
+ (let L (pack "Line")
+ (or
+ (>= 3 (length "Line"))
+ (sp? (car "Line"))
+ (= L (car "History"))
+ (push '"History" L) )
+ (and (nth "History" "HistMax") (con @))
+ L ) ) )
+
+### new Key codes (additional to lib/term.l) ###
+## (setq
+## *XtMf (in '("tput" "\033") (line T))
+## *XtMb (in '("tput" "\b") (line T))
+## *XtMd (in '("tput" "\d") (line T)) )
+
+## (fkey *XtMf (rWord))
+## (fkey *XtMb (lWord))
+## (fkey *XtMd (doUndo) (delWord T))
+
+(mapc zap
+ (quote
+ chgLine skipQ escQ delim? lMove bMove rMove eMove xMove lWord rWord lPar rPar
+ clrEol insChar del1 delChar delWord rplChar doUndo doPaste
+ setHist ledSearch expandTab insMode _getLine _led saveHistory ) )
+
+# vi:et:ts=3:sw=3
diff --git a/lib/led.l b/lib/led.l
@@ -1,4 +1,4 @@
-# 29dec11abu
+# 19nov12abu
# (c) Software Lab. Alexander Burger
# Line editor
@@ -6,6 +6,9 @@
# - Only single-key commands
# - No repeat count
+(mapc undef
+ '(*Led fkey revise) )
+
(setq
"Line" NIL # Holds current input line
"LPos" 1 # Position in line (1 .. length)
@@ -37,20 +40,20 @@
(and
*Tsm
(= "\"" (get "Line" P))
- ("skipQ" "LPos" P "Line") )
+ (skipQ "LPos" P "Line") )
(prin "^H") ) )
(for (P . C) (setq "Line" L) # Output new line
(cond
((> " " C)
(dec 'D)
(prin "_") )
- ((or (not *Tsm) (<> "\"" C) ("escQ" P L))
+ ((or (not *Tsm) (<> "\"" C) (escQ P L))
(dec 'D)
(prin C) )
(T
(prin
(and Tsm (cdr *Tsm))
- (unless ("skipQ" N P L)
+ (unless (skipQ N P L)
(dec 'D)
C )
(and (onOff Tsm) (car *Tsm)) ) ) ) )
@@ -63,21 +66,21 @@
(and
*Tsm
(= "\"" (get "Line" "LPos"))
- ("skipQ" N "LPos" "Line") )
+ (skipQ N "LPos" "Line") )
(prin "^H") )
(dec '"LPos") ) )
(flush) )
# Skipped double quote
-(de "skipQ" (N P L)
+(de skipQ (N P L)
(nor
(>= (inc N) P (dec N))
(= "\"" (get L (dec P)))
(= "\"" (get L (inc P)))
- ("escQ" P L) ) )
+ (escQ P L) ) )
# Escaped double quote
-(de "escQ" ()
+(de escQ ()
(let Esc NIL
(for I (dec P)
((if (= "\\" (get L I)) onOff off) Esc) ) ) )
@@ -428,4 +431,10 @@
(and (nth "History" "HistMax") (con @))
L ) ) )
+(mapc zap
+ (quote
+ chgLine delim? skipQ escQ lMove bMove rMove eMove xMove lWord rWord lPar rPar
+ clrEol insChar del1 delChar delWord rplChar doUndo doPaste
+ setHist ledSearch expandTab insMode cmdMode _getLine _led saveHistory ) )
+
# vi:et:ts=3:sw=3
