[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/rec-mode 969c03a 01/98: experimental/rec-mode.el rename
From: |
Stefan Monnier |
Subject: |
[elpa] externals/rec-mode 969c03a 01/98: experimental/rec-mode.el renamed to etc/rec-mode.el |
Date: |
Thu, 12 Nov 2020 13:18:28 -0500 (EST) |
branch: externals/rec-mode
commit 969c03a54cf5e8820365d6b48a26402a9702e3e0
Author: Jose E. Marchesi <jemarch@gnu.org>
Commit: Antoine Kalmbach <ane@iki.fi>
experimental/rec-mode.el renamed to etc/rec-mode.el
---
etc/rec-mode.el | 1620 +++++++++++++++++++++++++++++++++++++++++++++++++++++++
1 file changed, 1620 insertions(+)
diff --git a/etc/rec-mode.el b/etc/rec-mode.el
new file mode 100644
index 0000000..ed83d55
--- /dev/null
+++ b/etc/rec-mode.el
@@ -0,0 +1,1620 @@
+;;; rec-mode.el --- Major mode for viewing/editing rec files
+
+;; Copyright (C) 2009 Jose E. Marchesi
+
+;; Maintainer: Jose E. Marchesi
+
+;; 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, 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:
+
+;; A major mode for editing rec files.
+;;
+;; To see the structure of this file activate the outline minor mode
+;; and execute M-xhide-body
+
+;;; Code:
+
+;;;; Customization
+
+(defgroup rec-mode nil
+ "rec-mode subsystem"
+ :group 'applications
+ :link '(url-link "http://www.gnu.org/software/rec"))
+
+(defcustom rec-open-mode 'edit
+ "Default mode to use when switching a buffer to rec-mode.
+Valid values are `edit' and `navigation'. The default is `edit'"
+ :type 'symbol
+ :group 'rec-mode)
+
+(defvar rec-recsel "recsel"
+ "Name of the 'recsel' utility from the GNU recutils.")
+
+(defvar rec-recinf "recinf"
+ "Name of the 'recinf' utility from the GNU recutils.")
+
+;;;; Variables and constants that the user does not want to touch (really!)
+
+(defconst rec-keyword-rec "%rec"
+ ;; Remember to update `rec-font-lock-keywords' if you change this
+ ;; value!!
+ "Rec keyword.")
+
+(defvar rec-comment-re "^#.*"
+ "regexp denoting a comment line")
+
+(defvar rec-comment-field-re "^\\(#.*\n\\)*\\([a-zA-Z0-1_%-]+:\\)+"
+ "regexp denoting the beginning of a record")
+
+(defvar rec-field-name-re
+ "^\\([a-zA-Z0-1_%-]+:\\)+"
+ "Regexp matching a field name")
+
+(defvar rec-field-value-re
+ (let ((ret-re "\n\\+ ?")
+ (esc-ret-re "\\\\\n"))
+ (concat
+ "\\("
+ "\\(" ret-re "\\)*"
+ "\\(" esc-ret-re "\\)*"
+ "\\(" "\\\\[^\n]" "\\)*"
+ "[^\\\n]*"
+ "\\)*"))
+ "Regexp matching a field value")
+
+(defvar rec-field-re
+ (concat rec-field-name-re
+ rec-field-value-re
+ "\n")
+ "Regexp matching a field")
+
+(defvar rec-record-re
+ (concat rec-field-re "\\(" rec-field-re "\\|" rec-comment-re "\\)*")
+ "Regexp matching a record")
+
+(defvar rec-mode-syntax-table
+ (let ((st (make-syntax-table)))
+ (modify-syntax-entry ?# "<" st) ; Comment start
+ (modify-syntax-entry ?\n ">" st) ; Comment end
+ st)
+ "Syntax table used in rec-mode")
+
+(defvar rec-font-lock-keywords
+ `(("^%\\(rec\\|key\\|unique\\|type\\|prohibit\\|mandatory\\|doc\\|fsort\\):"
. font-lock-keyword-face)
+ (,rec-field-name-re . font-lock-variable-name-face)
+ ("^\\+" . font-lock-constant-face))
+ "Font lock keywords used in rec-mode")
+
+(defvar rec-mode-edit-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map "\C-cn" 'rec-cmd-goto-next-rec)
+ (define-key map "\C-cp" 'rec-cmd-goto-previous-rec)
+ (define-key map "\C-ce" 'rec-cmd-edit-field)
+ (define-key map "\C-ct" 'rec-cmd-show-descriptor)
+ (define-key map "\C-c#" 'rec-cmd-count)
+ (define-key map "\C-cl" 'rec-cmd-sel)
+ (define-key map "\C-cs" 'rec-cmd-search)
+ (define-key map "\C-cm" 'rec-cmd-trim-field-value)
+ (define-key map [remap move-beginning-of-line] 'rec-cmd-beginning-of-line)
+ (define-key map (kbd "TAB") 'rec-cmd-goto-next-field)
+ (define-key map (concat "\C-c" (kbd "RET")) 'rec-cmd-jump)
+ (define-key map "\C-cb" 'rec-cmd-jump-back)
+ (define-key map "\C-c\C-c" 'rec-finish-editing)
+ map)
+ "Keymap for rec-mode")
+
+(defvar rec-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map "n" 'rec-cmd-goto-next-rec)
+ (define-key map "p" 'rec-cmd-goto-previous-rec)
+ (define-key map "e" 'rec-cmd-edit-field)
+ (define-key map "R" 'rec-edit-record)
+ (define-key map "T" 'rec-edit-type)
+ (define-key map "B" 'rec-edit-buffer)
+ (define-key map "A" 'rec-cmd-append-field)
+ (define-key map "t" 'rec-cmd-show-descriptor)
+ (define-key map "l" 'rec-cmd-sel)
+ (define-key map "s" 'rec-cmd-search)
+ (define-key map "m" 'rec-cmd-trim-field-value)
+ (define-key map "\C-ct" 'rec-find-type)
+ (define-key map [remap move-beginning-of-line] 'rec-cmd-beginning-of-line)
+ (define-key map "#" 'rec-cmd-count)
+ (define-key map (kbd "RET") 'rec-cmd-jump)
+ (define-key map (kbd "TAB") 'rec-cmd-goto-next-field)
+ (define-key map "b" 'rec-cmd-jump-back)
+ map)
+ "Keymap for rec-mode")
+
+;;;; Parsing functions (rec-parse-*)
+;;
+;; Those functions read the contents of the buffer (starting at the
+;; current position of the pointer) and try to parse field, comment
+;; and records structures.
+
+(defun rec-parse-comment ()
+ "Parse and return a comment starting at point.
+
+Return a list whose first element is the symbol 'comment and the
+second element is the string with the contents of the comment,
+including the leading #:
+
+ (comment \"# foo\")
+
+If the point is not at the beginning of a comment return nil"
+ (when (and (equal (current-column) 0)
+ (looking-at rec-comment-re))
+ (goto-char (match-end 0))
+ (list 'comment (buffer-substring-no-properties (match-beginning 0)
+ (match-end 0)))))
+
+(defun rec-parse-field-name ()
+ "Parse and return a field name starting at point.
+
+Return a list with whose elements are the parts of the field
+name. For the name a:b:c:d: the following list is returned:
+
+ ('a' 'b' 'c' 'd')
+
+If the point is not at the beginning of a field name return nil"
+ (when (and (equal (current-column) 0)
+ (looking-at rec-field-name-re))
+ (goto-char (match-end 0))
+ (split-string
+ (buffer-substring-no-properties (match-beginning 0)
+ (- (match-end 0) 1))
+ ":")))
+
+(defun rec-parse-field-name-from-string (str)
+ "Parse and return a field name parsed from a string.
+
+If the string does not contain a field name, then return nil."
+ (with-temp-buffer
+ (insert str)
+ ;; Add a colon to the end if does not exist
+ (save-excursion
+ (goto-char (point-max))
+ (unless (equal (char-before) ?:)
+ (insert ?:)))
+ (goto-char (point-min))
+ (rec-parse-field-name)))
+
+(defun rec-parse-field-value ()
+ "Return the field value under the pointer.
+
+Return a string containing the value of the field.
+
+If the pointer is not at the beginning of a field value, return
+nil"
+ (when (looking-at rec-field-value-re)
+ (goto-char (match-end 0))
+ (let ((val (buffer-substring-no-properties (match-beginning 0)
+ (match-end 0))))
+ ;; Replace escaped newlines
+ (setq val (replace-regexp-in-string "\\\\\n" "" val))
+ ;; Replace continuation lines
+ (setq val (replace-regexp-in-string "\n\\+ ?" "\n" val))
+ ;; Remove the initial blank
+ (with-temp-buffer
+ (insert val)
+ (goto-char (point-min))
+ (if (equal (char-after (point)) ? )
+ (progn
+ (delete-char 1)))
+ (setq val (buffer-substring-no-properties (point-min)
+ (point-max))))
+;; (with-temp-buffer
+;; (insert val)
+;; (goto-char (point-min))
+;; (when (looking-at "[ \t\n]+")
+;; (delete-region (match-beginning 0)
+;; (match-end 0)))
+;; (setq val (buffer-substring-no-properties (point-min)
+;; (point-max))))
+ val)))
+
+(defun rec-parse-field ()
+ "Return a structure describing the field starting from the
+pointer.
+
+The returned structure is a list whose first element is the
+symbol 'field', the second element is the name of the field and
+the second element is the value of the field:
+
+ (field FIELD-NAME FIELD-VALUE)
+
+If the pointer is not at the beginning of a field
+descriptor then return nil"
+ (let ((there (point))
+ field-name field-value)
+ (and (setq field-name (rec-parse-field-name))
+ (setq field-value (rec-parse-field-value)))
+ (when (and field-name field-value)
+ (list 'field there field-name field-value))))
+
+(defun rec-parse-record ()
+ "Return a structure describing the record starting from the pointer.
+
+The returned structure is a list of fields preceded by the symbol
+'record':
+
+ (record FIELD-1 FIELD-2 ... FIELD-N)
+
+If the pointer is not at the beginning of a record, then return
+nil"
+ (let ((there (point))
+ record field-or-comment)
+ (while (setq field-or-comment (or (rec-parse-field)
+ (rec-parse-comment)))
+ (setq record (cons field-or-comment record))
+ ;; Skip the newline finishing the field or the comment
+ (when (looking-at "\n") (goto-char (match-end 0))))
+ (setq record (list 'record there (reverse record)))))
+
+;;;; Writer functions (rec-insert-*)
+;;
+;; Those functions dump the written representation of the parser
+;; structures (field, comment, record, etc) into the current buffer
+;; starting at the current position.
+
+(defun rec-insert-comment (comment)
+ "Insert the written form of COMMENT in the current buffer"
+ (when (and (listp comment)
+ (equal (car comment) 'comment))
+ (insert (cadr comment))))
+
+(defun rec-insert-field-name (field-name)
+ "Insert the written form of FIELD-NAME in the current buffer"
+ (when (listp field-name)
+ (mapcar (lambda (elem)
+ (when (stringp elem) (insert elem ":")))
+ field-name)))
+
+(defun rec-insert-field-value (field-value)
+ "Insert the written form of FIELD-VALUE in the current buffer"
+ (when (stringp field-value)
+ (let ((val field-value))
+ ;; FIXME: Maximum line size
+ (insert (replace-regexp-in-string "\n" "\n+ " val)))
+ (insert "\n")))
+
+(defun rec-insert-field (field)
+ "Insert the written form of FIELD in the current buffer"
+ (when (and (listp field)
+ (equal (car field) 'field))
+ (when (rec-insert-field-name (cadr field))
+ (insert " ")
+ (rec-insert-field-value (nth 2 field)))))
+
+(defun rec-insert-record (record &optional fields)
+ "Insert the written form of RECORD in the current buffer.
+
+If FIELDS is specified, it is a list of fields to include in the
+insertion. If a field in the list does not exist in the record
+it is ignored."
+ (when (and (listp record)
+ (equal (car record) 'record))
+ (rec-insert-record-2 (cdr record) fields)))
+
+(defun rec-insert-record-2 (record fields)
+ "Insert the written form of RECORD in the current buffer.
+Recursive part"
+ (when (and record (listp record))
+ (let ((elem (car record)))
+ (cond
+ ((and (not fields)
+ (equal (car elem) 'comment))
+ (rec-insert-comment elem))
+ ((and (equal (car elem) 'field)
+ (or (not fields)
+ (member (nth 1 elem) fields)))
+ (rec-insert-field elem))))
+ (rec-insert-record-2 (cdr record) fields)))
+
+;;;; Operations on record structures
+;;
+;; Those functions retrieve or set properties of field structures.
+
+(defun rec-record-p (record)
+ "Determine if the provided structure is a record."
+ (and (listp record)
+ (= (length record) 3)
+ (equal (car record) 'record)))
+
+(defun rec-record-position (record)
+ "Return the start position of the given record."
+ (when (rec-record-p record)
+ (nth 1 record)))
+
+(defun rec-record-fields (record)
+ "Return a list with the fields of the given record."
+ (when (rec-record-p record)
+ (nth 2 record)))
+
+(defun rec-record-assoc (name record)
+ "Get a list with the values of the fields in RECORD named NAME.
+
+XXX: describe NAME.
+
+If no such field exists in RECORD then nil is returned."
+ (if (stringp name)
+ (setq name (rec-parse-field-name-from-string name)))
+ (when (and (listp record)
+ (equal (car record) 'record))
+ (let (result)
+ (mapcar (lambda (field)
+ (when (and (equal (car field) 'field)
+ (equal name (rec-field-name field)))
+ (setq result (cons (nth 3 field) result))))
+ (rec-record-fields record))
+ (reverse result))))
+
+(defun rec-record-names (record)
+ "Get a list of the field names in the record"
+ (when (and (listp record)
+ (equal (car record) 'record))
+ (let (result)
+ (mapcar (lambda (field)
+ (when (and (equal (car field) 'field))
+ (setq result (cons (nth 1 field) result))))
+ (cdr record))
+ (reverse result))))
+
+;;;; Operations on field structures
+;;
+;; Those functions retrieve or set properties of field structures.
+
+(defun rec-field-p (field)
+ "Determine if the provided structure is a field"
+ (and (listp field)
+ (= (length field) 4)
+ (equal (car field) 'field)))
+
+(defun rec-field-position (field)
+ "Return the start position of the given field."
+ (when (rec-field-p field)
+ (nth 1 field)))
+
+(defun rec-field-name (field)
+ "Return the name of the provided field"
+ (when (rec-field-p field)
+ (nth 2 field)))
+
+(defun rec-field-value (field)
+ "Return the value of the provided field"
+ (when (rec-field-p field)
+ (nth 3 field)))
+
+(defun rec-field-trim-value (field)
+ "Trim the value of the given field."
+ (when (rec-field-p field)
+ (let ((value (nth 2 field))
+ c)
+ (with-temp-buffer
+ (insert value)
+ (goto-char (point-min))
+ (when (looking-at "[ \t\n]+")
+ (delete-region (match-beginning 0)
+ (match-end 0)))
+ (goto-char (point-max))
+ (setq c (char-before))
+ (while (and c
+ (or (equal c ?\n)
+ (equal c ?\t)
+ (equal c ? )))
+ (backward-char)
+ (setq c (char-before)))
+ (delete-region (point) (point-max))
+ (setq value (buffer-substring-no-properties (point-min)
+ (point-max))))
+ (setcar (cddr field) value))))
+
+;;;; Get entities under pointer
+;;
+;; Those functions retrieve structures of the entities under pointer
+;; like comments, fields and records. If the especified entity is not
+;; under the pointer then nil is returned.
+
+(defun rec-beginning-of-field-pos ()
+ "Return the position of the beginning of the current field, or
+nil if the pointer is not on a field."
+ (save-excursion
+ (beginning-of-line)
+ (let (res exit)
+ (while (not exit)
+ (cond
+ ((and (not (= (line-beginning-position) 1))
+ (or (looking-at "+")
+ (looking-back "\\\\\n" 2)))
+ (forward-line -1))
+ ((looking-at rec-field-name-re)
+ (setq res (point))
+ (setq exit t))
+ (t
+ (setq exit t))))
+ res)))
+
+(defun rec-end-of-field-pos ()
+ "Return the position of the end of the current field, or nil if
+the pointer is not on a field."
+ (let ((begin-pos (rec-beginning-of-field-pos)))
+ (when begin-pos
+ (save-excursion
+ (goto-char begin-pos)
+ ;; The following hack is due to the fact that
+ ;; the regular expressions search engine is
+ ;; hanging on rec-field-re
+ (when (looking-at rec-field-name-re)
+ (goto-char (match-end 0)))
+ (when (looking-at rec-field-value-re)
+ ;; The +1 is to include the \n at the beginning of the
+ ;; record value, that is part of the field but not part of
+ ;; the value
+ (+ (match-end 0) 1))))))
+
+(defun rec-beginning-of-comment-pos ()
+ "Return the position of the beginning of the current comment,
+or nil if the pointer is not on a comment."
+ (save-excursion
+ (beginning-of-line)
+ (when (looking-at rec-comment-re)
+ (point))))
+
+(defun rec-end-of-comment-pos ()
+ "Return the position of the end of the current comment,
+or nil if the pointer is not on a comment."
+ (let ((begin-pos (rec-beginning-of-comment-pos)))
+ (when begin-pos
+ (save-excursion
+ (goto-char begin-pos)
+ (when (looking-at rec-comment-re)
+ (match-end 0))))))
+
+(defun rec-beginning-of-record-pos ()
+ "Return the position of the beginning of the current record, or nil if
+the pointer is not on a record."
+ (save-excursion
+ (let (field-pos prev-pos)
+ (setq prev-pos (point))
+ (while (and (not (equal (point) (point-min)))
+ (or (setq field-pos (rec-beginning-of-field-pos))
+ (setq field-pos (rec-beginning-of-comment-pos))))
+ (goto-char field-pos)
+ (if (not (equal (point) (point-min)))
+ (backward-char)))
+ (unless (or (eobp)
+ (looking-at rec-comment-field-re))
+ (forward-char))
+ (when (looking-at rec-comment-field-re)
+ (point)))))
+
+(defun rec-end-of-record-pos ()
+ "Return the position of the end of the current record,
+or nil if the pointer is not on a record."
+ (let ((begin-pos (rec-beginning-of-record-pos)))
+ (when begin-pos
+ (save-excursion
+ (goto-char begin-pos)
+ (while (or (looking-at rec-field-name-re)
+ (looking-at rec-comment-re))
+ (goto-char (match-end 0))
+ (when (or (looking-at rec-field-value-re)
+ (looking-at rec-comment-re))
+ (goto-char (+ (match-end 0) 1))))
+ (point)))))
+
+(defun rec-current-field ()
+ "Return a structure with the contents of the current field.
+The current field is the field where the pointer is."
+ (save-excursion
+ (let ((begin-pos (rec-beginning-of-field-pos)))
+ (when begin-pos
+ (goto-char begin-pos)
+ (rec-parse-field)))))
+
+(defun rec-current-record ()
+ "Return a structure with the contents of the current record.
+The current record is the record where the pointer is"
+ (save-excursion
+ (let ((begin-pos (rec-beginning-of-record-pos)))
+ (when begin-pos
+ (goto-char begin-pos)
+ (rec-parse-record)))))
+
+;;;; Visibility
+;;
+;; These functions manage the visibility in the rec buffer.
+
+(defun rec-narrow-to-record ()
+ "Narrow to the current record, if any"
+ (let ((begin-pos (rec-beginning-of-record-pos))
+ (end-pos (rec-end-of-record-pos)))
+ (if (and begin-pos end-pos)
+ (narrow-to-region begin-pos end-pos))))
+
+(defun rec-narrow-to-type (type)
+ "Narrow to the specified type, if any"
+ (let ((begin-pos (or (rec-type-pos type) (point-min)))
+ (end-pos (or (rec-type-pos (rec-type-next type)) (point-max))))
+ (narrow-to-region begin-pos end-pos)))
+
+;;;; Record collection management
+;;
+;; These functions perform the management of the collection of records
+;; in the buffer.
+
+(defun rec-update-buffer-descriptors ()
+ "Get a list of the record descriptors in the current buffer."
+ (message "Updating record descriptors...")
+ (setq rec-buffer-descriptors
+ (save-excursion
+ (let ((rec-file-name (if buffer-file-name
+ buffer-file-name
+ ""))
+ descriptors records)
+ ;; Call 'recinf' to get the list of record descriptors in
+ ;; sexp format.
+ (with-temp-buffer
+ (call-process rec-recinf
+ nil ; infile
+ t ; output to current buffer
+ nil ; display
+ "-S" "-d" rec-file-name)
+ (goto-char (point-min))
+ (insert "(")
+ (goto-char (point-max))
+ (insert ")")
+ (setq descriptors (read (buffer-substring-no-properties
(point-min) (point-max)))))
+ ;; Calculate the value of 'rec-buffer-descriptors'.
+ (mapcar (lambda (descriptor)
+ (let ((marker (make-marker)))
+ (set-marker marker (rec-record-position descriptor))
+ (setq records (cons (list 'descriptor descriptor
marker) records))))
+ descriptors)
+ (reverse records))))
+ (message ""))
+
+(defun rec-update-buffer-descriptors-xxx ()
+ "Get a list of the record descriptors in the current buffer."
+ (message "Updating record descriptors...")
+ (setq rec-buffer-descriptors
+ (save-excursion
+ (let (records rec marker)
+ (goto-char (point-min))
+ (while (and (not (= (point) (point-max)))
+ (re-search-forward
+ (concat "^" (regexp-quote rec-keyword-rec) ":") nil
t))
+ (rec-beginning-of-record)
+ (setq marker (point-marker))
+ (setq rec (rec-parse-record))
+ (when (rec-record-assoc (list rec-keyword-rec) rec)
+ (setq records (cons (list 'descriptor rec marker) records)))
+ (if (not (= (point) (point-max)))
+ (forward-char)))
+ (reverse records))))
+ (message ""))
+
+(defun rec-buffer-types ()
+ "Return a list with the names of the record types in the
+existing buffer."
+ ;; If a descriptor has more than a %rec field, then the first one is
+ ;; used. The rest are ignored.
+ (mapcar
+ (lambda (elem) (car elem))
+ (mapcar
+ (lambda (elem)
+ (rec-record-assoc (list rec-keyword-rec) (cadr elem)))
+ rec-buffer-descriptors)))
+
+(defun rec-type-p (type)
+ "Determine if there are records of type TYPE in the current
+file."
+ (member type (rec-buffer-types)))
+
+(defun rec-goto-type (type)
+ "Goto the beginning of the descriptor with type TYPE.
+
+If the type do not exist in the current buffer then
+this function returns nil."
+ (if (or (not type)
+ (equal type ""))
+ ;; If there is a regular record in the
+ ;; beginning of the file, go there.
+ (if (save-excursion
+ (goto-char (point-min))
+ (unless (looking-at rec-comment-field-re)
+ (rec-goto-next-rec))
+ (rec-regular-p))
+ (progn
+ (goto-char (point-min))
+ (unless (looking-at rec-comment-field-re)
+ (rec-goto-next-rec))
+ t)
+ nil)
+ (let (found
+ (descriptors rec-buffer-descriptors))
+ (mapcar
+ (lambda (elem)
+ (when (equal (car (rec-record-assoc (list rec-keyword-rec)
+ (cadr elem)))
+ type)
+ (setq found t)
+ (goto-char (nth 2 elem))))
+ descriptors)
+ found)))
+
+(defun rec-type-pos (type)
+ "Return the position where the records of type TYPE start in
+the current file. If no records of type TYPE are defined in the
+current file then return nil."
+ (when (rec-type-p type)
+ (save-excursion
+ (rec-goto-type type)
+ (point))))
+
+(defun rec-type-next (type)
+ "Return the name of the type following TYPE in the file, if
+any. If the specified type is the last appearing in the file,
+or the specified type does not exist, then return nil."
+ (let ((types (member type (rec-buffer-types))))
+ (nth 1 types)))
+
+(defun rec-type-previous (type)
+ "Return the name of the type preceding TYPE in the file, if
+any. If the specified type is the first appearing in the file,
+or the specified type does not exist, then return nil."
+ (let ((types (member type (reverse (rec-buffer-types)))))
+ (nth 1 types)))
+
+(defun rec-goto-next-field ()
+ "Move the pointer to the beginning of the next field in the
+file."
+ (let ((pos (save-excursion
+ (rec-end-of-field)
+ (when (re-search-forward rec-field-name-re nil t)
+ (match-beginning 0)))))
+ (when pos
+ (goto-char pos)
+ t)))
+
+(defun rec-goto-next-rec ()
+ "Move the pointer to the beginning of the next record in the
+file."
+ (let ((pos (save-excursion
+ (rec-end-of-record)
+ (when (re-search-forward rec-comment-field-re nil t)
+ (match-beginning 0)))))
+ (when pos
+ (goto-char pos)
+ t)))
+
+(defun rec-goto-previous-rec ()
+ "Move the pointer to the end of the previous record in the
+file."
+ (let ((pos (save-excursion
+ (rec-beginning-of-record)
+ (if (not (= (point) (point-min)))
+ (backward-char))
+ (when (and (re-search-backward rec-record-re nil t)
+ (rec-beginning-of-record))
+ (point)))))
+ (when pos
+ (goto-char pos)
+ t)))
+
+(defun rec-type-first-rec-pos (type)
+ "Return the position of the first record of the specified TYPE.
+
+If TYPE is nil then return the position of the first regular record in the
file.
+If there are no regular records in the file, return nil."
+ (save-excursion
+ (when (or (not type) (rec-type-p type))
+ (if type
+ (rec-goto-type type)
+ (goto-char (point-min)))
+ ;; Find the next regular record
+ (when (and (rec-goto-next-rec)
+ (rec-regular-p))
+ (point)))))
+
+(defun rec-goto-type-first-rec (type)
+ "Goto to the first record of type TYPE present in the file.
+If TYPE is nil then goto to the first Unknown record on the file.
+
+If the record is found, return its position.
+If no such record exist then don't move and return nil."
+ (let ((pos (rec-type-first-rec-pos type)))
+ (when pos
+ (goto-char pos))))
+
+(defun rec-count (&optional type)
+ "If TYPE is a string, return the number of records of the
+specified type in the current file."
+ (let (num
+ (rec-file-name (if buffer-file-name
+ buffer-file-name
+ "")))
+ (with-temp-buffer
+ (if (stringp type)
+ (call-process rec-recsel
+ nil ; infile
+ t ; output to current buffer.
+ nil ; display
+ "-t" type "-c" rec-file-name)
+ (call-process rec-recsel
+ nil ; infile
+ t ; output to current buffer.
+ nil ; display
+ "-c" rec-file-name))
+ (setq num (buffer-substring-no-properties (point-min) (point-max))))
+ (string-to-number num)))
+
+(defun rec-do (rec-do-func &optional type descriptors)
+ "Apply REC-DO-FUNC for each record of type TYPE. If TYPE is nil
+then the function is applied for all the records existing in the
+file (including the record descriptors). A third optional
+parameter specify whether to include the record descriptors in
+the list of records."
+ (save-excursion
+ (save-restriction
+ (widen)
+ (unless (rec-goto-type type)
+ (goto-char (point-min))
+ (rec-goto-next-rec))
+ (let ((in-type t)
+ (first-time t)
+ exit)
+ (while (and (not exit)
+ in-type
+ (if (not first-time)
+ (rec-goto-next-rec)
+ t))
+ (setq first-time nil)
+ (setq in-type (or (not type)
+ (equal (rec-record-type) type)))
+ (when (and in-type
+ (or descriptors
+ (rec-regular-p)))
+ (setq exit (not (funcall rec-do-func)))))))))
+
+(defun rec-map (rec-map-func &optional type descriptors)
+ "XXX"
+ (let (res)
+ (rec-do (lambda ()
+ (setq res
+ (cons (funcall rec-map-func)
+ res))
+ t)
+ type
+ descriptors)
+ (reverse res)))
+
+(defun rec-regular-p ()
+ "Return t if the record under point is a regular record.
+Return nil otherwise."
+ (let ((rec (rec-current-record)))
+ (when rec
+ (= (length (rec-record-assoc (list rec-keyword-rec) rec))
+ 0))))
+
+(defun rec-record-type ()
+ "Return the type of the record under point.
+
+If the record is of no known type, return nil."
+ (let ((descriptor (rec-record-descriptor)))
+ (cond
+ ((listp descriptor)
+ (car (rec-record-assoc (list rec-keyword-rec)
+ (cadr descriptor))))
+ ((equal descriptor "")
+ "")
+ (t
+ nil))))
+
+(defun rec-record-descriptor ()
+ "Return the record descriptor of the record under point.
+
+Return \"\" if no proper record descriptor is found in the file.
+Return nil if the point is not on a record."
+ (when (rec-current-record)
+ (let ((descriptors rec-buffer-descriptors)
+ descriptor type position found
+ (i 0))
+ (while (and (not found)
+ (< i (length descriptors)))
+ (setq descriptor (nth i rec-buffer-descriptors))
+ (setq position (marker-position (nth 2 descriptor)))
+ (if (and (>= (point) position)
+ (or (= i (- (length rec-buffer-descriptors) 1))
+ (< (point) (marker-position (nth 2 (nth (+ i 1)
rec-buffer-descriptors))))))
+ (setq found t)
+ (setq i (+ i 1))))
+ (if found
+ descriptor
+ ""))))
+
+;;;; Searching functions
+
+(defun rec-search-first (type name value)
+ "Return the position of the beginning of the record of type TYPE
+containing a field NAME:VALUE.
+
+If such a record is not found then return nil."
+ (save-excursion
+ (let (found end-of-type record)
+ (when (rec-goto-type type)
+ (while (and (not found) (not end-of-type)
+ (rec-goto-next-rec))
+ ;; Read a record
+ (setq record (rec-current-record))
+ ;; Check if found
+ (if (member value (rec-record-assoc name record))
+ (setq found t)
+ ;; Check end-of-type
+ (if (rec-record-assoc (list rec-keyword-rec) record)
+ (setq end-of-type t))))
+ (when found (point))))))
+
+;;;; Selecting
+
+(defun rec-sel (what func &optional type write-descriptor)
+ "Make a selection on the rec file.
+
+FUNC is a function that will be evaluated XXX.
+
+If some of the fields specified in WHAT does not exist in the
+matching records, then they are not included in the result.
+
+NAME is the name of a field, like \"Name\", that will be compared
+with \"VALUE\".
+
+If WRITE-DESCRIPTOR is t, then record descriptors are included in
+the result buffer."
+ (let ((sel-buffer
+ (get-buffer-create (generate-new-buffer-name "Rec Sel ")))
+ inserted-types)
+ (with-current-buffer sel-buffer
+ (insert "# -*- mode: rec -*- \n"
+ "#\n"
+ "# Result of rec-sel with \n# ")
+ (print func (lambda (c) (unless (equal c ?\n) (insert c))))
+ (insert "\n\n"))
+ (message "Searching...")
+ (rec-do
+ (lambda ()
+ (save-excursion
+ (let* ((rec (rec-parse-record))
+ (type (rec-record-type))
+ (descriptor (rec-record-descriptor)))
+ (when (apply func (list rec))
+ ;; Matching record
+ ;; Print it (the requested fields)
+ (with-current-buffer sel-buffer
+ (let (buffer-read-only)
+ (when (and descriptor
+ (not (member type inserted-types)))
+ (when write-descriptor
+ ;; Insert the type descriptor
+ (rec-insert-record (cadr descriptor)))
+ (insert "\n")
+ (setq inserted-types
+ (cons type inserted-types)))
+ (rec-insert-record rec what)
+ (insert "\n")))))
+ t))
+ type)
+ (with-current-buffer sel-buffer
+ (insert "\n"
+ "# End of rec-sel\n")
+ (goto-char (point-min))
+ (rec-mode))
+ (switch-to-buffer-other-window sel-buffer)
+ (message "")))
+
+;;;; Selection macros
+;;
+;; Note that in the context of the body in the following macros `rec'
+;; is a record data structure.
+
+(defmacro rec-field-eq (name val)
+ `(let ((value (rec-record-assoc ,name rec)))
+ (if value
+ (equal (car value) ,val)
+ nil)))
+
+(defmacro rec-field-count (name)
+ `(lenth (rec-record-assoc ,name rec)))
+
+;;;; Navigation
+
+(defun rec-show-type (type)
+ "Show the records of the given type"
+ (widen)
+ (unless (rec-goto-type type)
+ (message "No records with that type found in the file"))
+ (rec-show-record))
+
+(defun rec-show-record ()
+ "Show the record under the point"
+ (setq buffer-read-only t)
+ (rec-narrow-to-record)
+ (use-local-map rec-mode-map)
+ ;; TODO: Update field names for autocompletion
+ ;; (let ((names (rec-record-field-names (rec-current-record)))))
+ (rec-set-mode-line (rec-record-type)))
+
+;;;; Mode line
+
+(defun rec-set-mode-line (str)
+ "Set the modeline in rec buffers"
+ (setq mode-line-buffer-identification
+ (list 20
+ "%b " str)))
+
+;;;; Fast selection
+
+(defun rec-fast-selection (names prompt)
+ "Fast group tag selection with single keys.
+
+NAMES is an association list of the form:
+
+ ((\"NAME1\" char1) ...)
+
+Each character should identify only one name."
+ ;; Adapted from `org-fast-tag-selection' in org.el by Carsten Dominic
+ ;; Thanks Carsten! :D
+ (let* ((maxlen (apply 'max (mapcar (lambda (name)
+ (string-width (car name))) names)))
+ (buf (current-buffer))
+ (fwidth (+ maxlen 3 1 3))
+ (ncol (/ (- (window-width) 4) fwidth))
+ name count result char i key-list)
+ (save-window-excursion
+ (set-buffer (get-buffer-create " *Rec Fast Selection*"))
+ (delete-other-windows)
+ (split-window-vertically)
+ (switch-to-buffer-other-window (get-buffer-create " *Rec Fast
Selection*"))
+ (erase-buffer)
+ (insert prompt ":")
+ (insert "\n\n")
+ (setq count 0)
+ (while (setq name (pop names))
+ (setq key-list (cons (cadr name) key-list))
+ (insert "[" (cadr name) "] "
+ (car name)
+ (make-string (- fwidth 4 (length (car name))) ?\ ))
+ (when (= (setq count (+ count 1)) ncol)
+ (insert "\n")
+ (setq count 0)))
+ (goto-char (point-min))
+ (if (fboundp 'fit-window-to-buffer)
+ (fit-window-to-buffer))
+ (catch 'exit
+ (while t
+ (message "[a-z0-9...]: Select entry [RET]: Exit")
+ (setq char (let ((inhibit-quit t)) (read-char-exclusive)))
+ (cond
+ ((= char ?\r)
+ (setq result nil)
+ (throw 'exit t))
+ ((member char key-list)
+ (setq result char)
+ (throw 'exit t)))))
+ result)))
+
+(defun rec-selection-list ()
+ "XXX"
+ (let (search-list)
+ ;; Add standard searches
+ (add-to-list 'search-list
+ (list "Generic search" ?E))
+ ;; Add custom searches
+ (append search-list
+ (mapcar
+ (lambda (elem)
+ (if (and (listp elem)
+ (>= (length elem) 4))
+ (let ((char (car elem))
+ (descr (cadr elem)))
+ (list descr char))
+ (error "Invalid entry in rec-custom-searches")))
+ rec-custom-searches))))
+
+(defun rec-init-selections ()
+ "XXX"
+ (let (res)
+ (rec-do
+ (lambda ()
+ (let* ((rec (rec-parse-record))
+ (name (rec-record-assoc (list "Name") rec))
+ (letter (rec-record-assoc (list "Letter") rec))
+ (fields (rec-record-assoc (list "Field") rec))
+ (type (rec-record-assoc (list "Type") rec))
+ (expr (rec-record-assoc (list "Predicate") rec)))
+ (when (and (equal (length name) 1)
+ (equal (length letter) 1)
+ (equal (length (car letter)) 1)
+ (equal (length expr) 1))
+ (add-to-list 'res
+ (list (aref (car letter) 0)
+ (car name)
+ (mapcar (lambda (elem)
+ (rec-parse-field-name-from-string
elem)) fields)
+ (read (car expr))
+ type)))
+ t))
+ "RecModeSelection")
+ (setq rec-custom-searches res)))
+
+;;;; Rec Idle mode
+;;
+;; This section is heavily inspired in semantic-idle.el
+
+(defvar rec-idle-scheduler-timer nil
+ "*Timer used to schedule tasks in idle time.")
+
+(defvar rec-idle-scheduler-work-timer nil
+ "*Timer used to schedule tasks in idle time that may take a
+ while.")
+
+(defcustom rec-idle-scheduler-idle-time 2
+ "*Time in seconds of idle before scheduling events.
+This time should be short enough to ensure that idle-scheduler
+will be run as soon as Emacs is idle."
+ :group 'rec
+ :type 'number
+ :set (lambda (sym val)
+ (set-default sym val)
+ (when (timerp rec-idle-scheduler-timer)
+ (cancel-timer rec-idle-scheduler-timer)
+ (setq rec-idle-scheduler-timer nil)
+ (rec-idle-scheduler-setup-timers))))
+
+(defcustom rec-idle-scheduler-work-idle-time 60
+ "*Time in seconds of idle before scheduling big work.
+This time should be long enough that once any big work is
+started, it is unlikely the user would be ready to type again
+right away."
+ :group 'rec
+ :type 'number
+ :set (lambda (sym val)
+ (set-default sym val)
+ (when (timerp rec-idle-scheduler-work-timer)
+ (cancel-timer rec-idle-scheduler-work-timer)
+ (setq semantic-idle-scheduler-work-timer nil)
+ (rec-idle-scheduler-setup-timers))))
+
+(defun rec-idle-scheduler-setup-timers ()
+ "Lazy initialization of the auto parse idle timer."
+ (or (timerp rec-idle-scheduler-timer)
+ (setq rec-idle-scheduler-timer
+ (run-with-idle-timer
+ rec-idle-scheduler-idle-time t
+ #'rec-idle-scheduler-function)))
+ (or (timerp rec-idle-scheduler-work-timer)
+ (setq rec-idle-scheduler-work-timer
+ (run-with-idle-timer
+ rec-idle-scheduler-work-idle-time t
+ #'rec-idle-scheduler-work-function))))
+
+(defun rec-idle-scheduler-kill-timer ()
+ "Kill the rec idle timer."
+ (if (timerp rec-idle-scheduler-timer)
+ (cancel-timer rec-idle-scheduler-timer))
+ (setq rec-idle-scheduler-timer nil))
+
+(defcustom rec-idle-scheduler-mode-hook nil
+ "*HOok run at the end of function `rec-idle-scheduler-mode'."
+ :group 'semantic
+ :type 'hook)
+
+(defvar rec-idle-scheduler-mode nil
+ "Non-nil if idle-scheduler minor mode is enabled.
+Use the command `rec-idle-scheduler-mode' to change this variable.")
+(make-variable-buffer-local 'rec-idle-scheduler-mode)
+
+(defcustom rec-idle-scheduler-max-buffer-size 0
+ "*Maximum size in bytes of buffers where idle-scheduler is enabled.
+If this value is less than or equal to 0, idle-schedule is enabled in
+all buffers regardless of their size."
+ :group 'rec
+ :type 'number)
+
+(defsubst rec-idle-scheduler-enabled-p ()
+ "Return non-nil if idle-scheduler is enabled for this buffer.
+idle-scheduler is disabled when debugging or if the buffer size
+exceeds the `rec-idle-scheduler-max-buffer-size' threshold."
+ (and rec-idle-scheduler-mode
+ (or (<= rec-idle-scheduler-max-buffer-size 0)
+ (< (buffer-size) rec-idle-scheduler-max-buffer-size))))
+
+(defun rec-idle-scheduler-mode-setup ()
+ "Setup option `rec-idle-scheduler-mode'.
+The minor mode can be turned on only if rec is available. When
+minor mode is enabled process the current buffer if needed.
+Return non-nil if the minor mode is enabled."
+ (if rec-idle-scheduler-mode
+ (if (not (featurep 'rec-mode))
+ (progn
+ ;; Disable minor mode if rec-mode not available
+ (setq rec-idle-scheduler-mode nil)
+ (error "Buffer %s was not set up idle time scheduling"
+ (buffer-name)))
+ (rec-idle-scheduler-setup-timers)))
+ rec-idle-scheduler-mode)
+
+(defun rec-idle-scheduler-mode (&optional arg)
+ "Minor mode to auto analyze buffer following a change.
+When this mode is off, a buffer is only rescanned for record
+types when some command requests the list of available types.
+When idle-scheduler is enabled, Emacs periodically checks to see
+if the buffer is out of date, and reanalyzes while the user is
+idle (not typing).
+
+With prefix argument ARG, turn on if positive, otherwise off.
+The minor mode can be turned on only if rec-mode feature is
+available and the current buffer is in rec mode. Return non-nil
+if the minor mode is enabled."
+ (interactive
+ (list (or current-prefix-arg
+ (if rec-idle-scheduler-mode 0 1))))
+ (setq rec-idle-scheduler-mode
+ (if arg
+ (>
+ (prefix-numeric-value arg)
+ 0)
+ (not rec-idle-scheduler-mode)))
+ (rec-idle-scheduler-mode-setup)
+ (run-hooks 'rec-idle-scheduler-mode-hook)
+ (if (interactive-p)
+ (message "rec-idle-scheduler minor mode %sabled"
+ (if rec-idle-scheduler-mode "en" "dis")))
+ ;; FIXME: add a note in the modeline
+ rec-idle-scheduler-mode)
+
+(defun rec-idle-scheduler-function ()
+ "Function run when after `rec-idle-scheduler-idle-time'.
+This function will reanalyze the current buffer, and if successful,
+call additional functions registered with the timer calls."
+ (when (zerop (recursion-depth))
+ (let ((debug-on-error nil))
+ (save-match-data (rec-idle-core-handler)))))
+
+;;;; Commands
+;;
+;; The following functions are implementing commands available in the
+;; modes.
+
+(defun rec-cmd-edit-field ()
+ "Edit the contents of the field under point in a separate
+buffer"
+ (interactive)
+ (let* (edit-buf
+ (field (rec-current-field))
+ (field-value (rec-field-value field))
+ (field-name (rec-field-name field))
+ (pointer (rec-beginning-of-field-pos))
+ (prev-buffer (current-buffer)))
+ (if field-value
+ (progn
+ (setq edit-buf (get-buffer-create "Rec Edit"))
+ (set-buffer edit-buf)
+ (delete-region (point-min) (point-max))
+ (rec-edit-field-mode)
+ (make-local-variable 'rec-field-name)
+ (setq rec-field-name field-name)
+ (make-local-variable 'rec-marker)
+ (setq rec-marker (make-marker))
+ (set-marker rec-marker pointer prev-buffer)
+ (make-local-variable 'rec-buffer)
+ (setq rec-prev-buffer prev-buffer)
+ (setq rec-pointer pointer)
+ (insert field-value)
+ (switch-to-buffer-other-window edit-buf)
+ (goto-char (point-min))
+ (message "Edit the value of the field and press C-c C-c to exit"))
+ (message "Not in a field"))))
+
+(defun rec-finish-editing-field ()
+ "Stop editing the value of a field."
+ (interactive)
+ (let ((marker rec-marker)
+ (prev-pointer rec-pointer)
+ (edit-buffer (current-buffer))
+ (name rec-field-name)
+ (value (buffer-substring-no-properties (point-min) (point-max))))
+ (delete-window)
+ (switch-to-buffer rec-prev-buffer)
+ (let ((buffer-read-only nil))
+ (kill-buffer edit-buffer)
+ (goto-char marker)
+ (rec-delete-field)
+ (rec-insert-field (list 'field
+ name
+ value))
+ (goto-char prev-pointer)))
+ (rec-init-selections))
+
+(defun rec-beginning-of-field ()
+ "Goto to the beginning of the current field"
+ (interactive)
+ (let ((pos (rec-beginning-of-field-pos)))
+ (when pos
+ (goto-char pos))))
+
+(defun rec-end-of-field ()
+ "Goto to the end of the current field"
+ (interactive)
+ (let ((pos (rec-end-of-field-pos)))
+ (when pos
+ (goto-char pos))))
+
+(defun rec-beginning-of-record ()
+ "Goto to the beginning of the current record"
+ (interactive)
+ (let ((pos (rec-beginning-of-record-pos)))
+ (when pos
+ (goto-char pos))))
+
+(defun rec-end-of-record ()
+ "Goto to the end of the current record"
+ (interactive)
+ (let ((pos (rec-end-of-record-pos)))
+ (when pos
+ (goto-char pos))))
+
+(defun rec-kill-field ()
+ "Kill the current field"
+ (interactive)
+ (let ((begin-pos (rec-beginning-of-field-pos))
+ (end-pos (rec-end-of-field-pos)))
+ (when (and begin-pos end-pos)
+ (kill-region begin-pos end-pos))))
+
+(defun rec-copy-field ()
+ "Copy the current field"
+ (interactive)
+ (let ((begin-pos (rec-beginning-of-field-pos))
+ (end-pos (rec-end-of-field-pos)))
+ (when (and begin-pos end-pos)
+ (copy-region-as-kill begin-pos end-pos))))
+
+(defun rec-delete-field ()
+ "Delete the current field"
+ (interactive)
+ (let ((begin-pos (rec-beginning-of-field-pos))
+ (end-pos (rec-end-of-field-pos)))
+ (when (and begin-pos end-pos)
+ (delete-region begin-pos end-pos))))
+
+(defun rec-copy-record ()
+ "Copy the current record"
+ (interactive))
+
+(defun rec-find-type ()
+ "Goto the beginning of the descriptor with a given type."
+ (interactive)
+ (let ((type (completing-read "Record type: "
+ (save-restriction
+ (widen)
+ (rec-buffer-types)))))
+ (if (equal type "") (setq type nil))
+ (rec-show-type type)))
+
+(defun rec-cmd-goto-next-field ()
+ "Move the pointer to the beginning of the next field in the
+record. Interactive version."
+ (interactive)
+ (if (save-excursion
+ (not (rec-goto-next-field)))
+ (if rec-editing
+ (progn
+ (goto-char (point-min))
+ (unless (looking-at rec-field-name-re)
+ (rec-goto-next-field)))
+ (rec-beginning-of-record))
+ (rec-goto-next-field)))
+
+(defun rec-cmd-goto-next-rec ()
+ "Move the pointer to the beginning of the next record in the
+file. Interactive version."
+ (interactive)
+ (widen)
+ (if (save-excursion
+ (not (rec-goto-next-rec)))
+ (message "No more records")
+ (rec-goto-next-rec))
+ (unless rec-editing
+ (rec-show-record)))
+
+(defun rec-cmd-goto-previous-rec ()
+ "Move the pointer to the beginning of the previous record in
+the file. Interactive version."
+ (interactive)
+ (widen)
+ (if (save-excursion
+ (not (rec-goto-previous-rec)))
+ (message "No more records")
+ (rec-goto-previous-rec))
+ (unless rec-editing
+ (rec-show-record)))
+
+(defun rec-cmd-jump ()
+ "Jump to the first record containing the reference under
+point."
+ (interactive)
+ (widen)
+ (let (size field name value)
+ (if (setq field (rec-current-field))
+ (progn (setq name (rec-field-name field))
+ (setq value (rec-field-value field))
+ (if (or (= (length name) 2)
+ (= (length name) 3))
+ (progn
+ (let* ((field-type (nth 0 name))
+ (field-name (nth 1 name))
+ (pos (rec-search-first field-type
+ (list field-name)
+ value)))
+ (if pos
+ (progn
+ (setq rec-jump-back (point-marker))
+ (goto-char pos)
+ (unless rec-editing
+ (rec-narrow-to-record)))
+ (message "Not found.")
+ (unless rec-editing
+ (rec-show-record)))))
+ (message "Not in a reference.")
+ (unless rec-editing
+ (rec-show-record))))
+ (message "Not in a reference.")
+ (save-excursion
+ (rec-goto-previous-rec)
+ (unless rec-editing
+ (rec-show-record))))))
+
+(defun rec-cmd-jump-back ()
+ "Undo the previous jump"
+ (interactive)
+ (if rec-jump-back
+ (progn
+ (widen)
+ (goto-char (marker-position rec-jump-back))
+ (unless rec-editing
+ (rec-show-record))
+ (setq rec-jump-back nil))
+ (message "No previous position to jump")))
+
+(defun rec-edit-record ()
+ "Go to the record edition mode"
+ (interactive)
+ (setq rec-editing t)
+ (setq buffer-read-only nil)
+ (use-local-map rec-mode-edit-map)
+ (rec-set-mode-line "Edit record")
+ (setq rec-update-p t)
+ (setq rec-preserve-last-newline t)
+ (message "Editing: Press C-c C-c when you are done"))
+
+(defun rec-edit-type ()
+ "Go to the type edition mode"
+ (interactive)
+ (setq rec-editing t)
+ (setq buffer-read-only nil)
+ (use-local-map rec-mode-edit-map)
+ (widen)
+ (rec-narrow-to-type (rec-record-type))
+ (setq rec-update-p t)
+ (goto-char (point-min))
+ (rec-set-mode-line "Edit type")
+ (message "Editing: Press C-c C-c when you are done"))
+
+(defun rec-edit-buffer ()
+ "Go to the buffer edition mode"
+ (interactive)
+ (setq rec-editing t)
+ (setq buffer-read-only nil)
+ (use-local-map rec-mode-edit-map)
+ (widen)
+ (setq rec-update-p t)
+ (goto-char (point-min))
+ (rec-set-mode-line "Edit buffer")
+ (message "Editing: Press C-c C-c when you are done"))
+
+(defun rec-finish-editing ()
+ "Go back from the record edition mode"
+ (interactive)
+ (or (rec-current-record)
+ (rec-goto-next-rec)
+ (rec-goto-previous-rec))
+ (when rec-preserve-last-newline
+ (save-excursion
+ (goto-char (point-max))
+ (unless (equal (char-before) ?\n)
+ (insert ?\n))))
+ (when rec-update-p
+ (save-restriction
+ (widen)
+ (rec-update-buffer-descriptors))
+ (setq rec-update-p nil))
+ (rec-show-record)
+ ;; TODO: Restore modeline
+ (rec-set-mode-line (rec-record-type))
+ (setq rec-editing nil)
+ (rec-init-selections)
+ (message "End of edition"))
+
+(defun rec-cmd-show-descriptor ()
+ "Show the descriptor record of the current record.
+
+This jump sets jump-back."
+ (interactive)
+ (let ((type (rec-record-type)))
+ (when type
+ (setq rec-jump-back (point-marker))
+ (if rec-editing
+ (rec-goto-type type)
+ (rec-show-type type)))))
+
+(defun rec-cmd-count ()
+ "Display a message in the minibuffer showing the number of
+records of the current type"
+ (interactive)
+ (message "Counting records...")
+ (let ((type (rec-record-type)))
+ (message (concat (number-to-string (rec-count type))
+ (if (or (not type)
+ (equal type ""))
+ " records"
+ (concat " records of type " type))))))
+
+(defun rec-cmd-append-field ()
+ "Goto the end of the record and switch to edit record mode."
+ (interactive)
+ (unless rec-editing
+ (rec-edit-record)
+ (goto-char (point-max))
+ (insert "\n")
+ (backward-char)))
+
+(defun rec-cmd-sel ()
+ "XXX"
+ (interactive)
+ (let ((res (rec-fast-selection
+ (rec-selection-list)
+ "Selection Type")))
+ (cond
+ ((equal res ?E)
+ ;; Prompt the user for an expression and search
+ (let (what func name type)
+ (setq type (read-from-minibuffer "Type of record (empty for all): "))
+ (if (equal type "")
+ (setq type nil)
+ (when (not (member type (rec-buffer-types)))
+ (error (concat "cannot find type " type))))
+ (while (not (equal
+ (setq name
+ (read-from-minibuffer "Field to print (empty when
done): "))
+ ""))
+ (add-to-list 'what
+ (rec-parse-field-name-from-string name)))
+ (setq func (read-from-minibuffer "Search expression: "))
+ (rec-sel what (read (concat "(lambda (rec) " func ")")) type)))
+ (res
+ ;; Launch the appropriate expression
+ (let* ((search (assoc res rec-custom-searches))
+ (what (nth 2 search))
+ (func (nth 3 search))
+ (type (nth 4 search)))
+ (rec-sel what (list 'lambda (list 'rec) func) type))))))
+
+(defun rec-cmd-trim-field-value ()
+ "Trim the value of the field under point, if any."
+ (interactive)
+ (save-excursion
+ (let ((buffer-read-only nil)
+ (field (rec-current-field)))
+ (rec-field-trim-value field)
+ (rec-delete-field)
+ (rec-insert-field field))))
+
+(defun rec-cmd-beginning-of-line ()
+ "Move the point to the beginning of the current line.
+
+If the current line is part of the value of a field then go to
+the first character of the line being part of the value."
+ (interactive)
+ (beginning-of-line)
+ ;; Skip a field name or a continuation line.
+ (cond
+ ((looking-at rec-field-name-re)
+ (rec-parse-field-name)
+ (when (looking-at " ") (forward-char 1)))
+ ((looking-at "\+ ?")
+ (forward-char 1)
+ (when (looking-at " ") (forward-char 1)))))
+
+;;;; Definition of modes
+
+(defun rec-mode ()
+ "A major mode for editing rec files.
+
+Commands:
+\\{rec-mode-map}"
+ (interactive)
+ (kill-all-local-variables)
+ ;; Local variables
+ (make-local-variable 'font-lock-defaults)
+ (make-local-variable 'rec-type)
+ (make-local-variable 'rec-buffer-descriptors)
+ (make-local-variable 'rec-jump-back)
+ (make-local-variable 'rec-update-p)
+ (make-local-variable 'rec-preserve-last-newline)
+ (make-local-variable 'rec-editing)
+ (make-local-variable 'rec-field-names)
+ (make-local-variable 'rec-custom-searches)
+ (setq rec-editing nil)
+ (setq rec-jump-back nil)
+ (setq rec-update-p nil)
+ (setq rec-preserve-last-newline nil)
+ (setq rec-field-names nil)
+ (setq rec-custom-searches nil)
+ (setq font-lock-defaults '(rec-font-lock-keywords))
+ (use-local-map rec-mode-map)
+ (set-syntax-table rec-mode-syntax-table)
+ (setq mode-name "Rec")
+ (setq major-mode 'rec-mode)
+ ;; Goto the first record of the first type (including the Unknown)
+ (rec-update-buffer-descriptors)
+ ;; Initialize the value of rec-custom-searches
+ (rec-init-selections)
+ (if (equal rec-open-mode 'navigation)
+ (progn
+ (setq buffer-read-only t)
+ (setq rec-type (car (rec-buffer-types)))
+ (rec-show-type rec-type))
+ ;; Edit mode
+ (use-local-map rec-mode-edit-map)
+ (setq rec-editing t)
+ (rec-set-mode-line "Edit buffer")))
+
+(defvar rec-edit-field-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map "\C-c\C-c" 'rec-finish-editing-field)
+ map)
+ "Keymap for rec-edit-field-mode")
+
+(defun rec-edit-field-mode ()
+ "A major mode for editing rec field values.
+
+Commands:
+\\{rec-edit-field-mode-map}"
+ (interactive)
+ (kill-all-local-variables)
+ (use-local-map rec-edit-field-mode-map)
+ (setq mode-name "Rec Edit")
+ (setq major-mode 'rec-edit-field-mode))
+
+(provide 'rec-mode)
+
+;; Local variables:
+;; outline-regexp: ";;;;"
+;; End:
+
+;;; rec-mode.el ends here
- [elpa] branch externals/rec-mode created (now d0e8456), Stefan Monnier, 2020/11/12
- [elpa] externals/rec-mode 1f0916b 02/98: Trailing blanks removed., Stefan Monnier, 2020/11/12
- [elpa] externals/rec-mode 785b4b8 04/98: misc changes to rec-mode.el, Stefan Monnier, 2020/11/12
- [elpa] externals/rec-mode 969c03a 01/98: experimental/rec-mode.el renamed to etc/rec-mode.el,
Stefan Monnier <=
- [elpa] externals/rec-mode 0731ca5 11/98: ob-rec.el imported in the repo., Stefan Monnier, 2020/11/12
- [elpa] externals/rec-mode a1e21e1 14/98: Added %typedef to the list of keywords., Stefan Monnier, 2020/11/12
- [elpa] externals/rec-mode 06ec5c5 17/98: ob-rec: support for :sort and minor fixes., Stefan Monnier, 2020/11/12
- [elpa] externals/rec-mode 2f8aa87 16/98: ob-rec: support for :sort and minor fixes., Stefan Monnier, 2020/11/12
- [elpa] externals/rec-mode fbd02a9 24/98: rec-mode: field names are no longer lists of parts., Stefan Monnier, 2020/11/12
- [elpa] externals/rec-mode 0b52532 18/98: ob-rec: support for :sort and minor fixes., Stefan Monnier, 2020/11/12
- [elpa] externals/rec-mode 18e9e4a 23/98: rec-mode: editing of individual fields now works., Stefan Monnier, 2020/11/12
- [elpa] externals/rec-mode 424eb72 25/98: rec-mode: fixes in goto-type and show-type., Stefan Monnier, 2020/11/12
- [elpa] externals/rec-mode f063506 26/98: rec-mode: misc small fixes., Stefan Monnier, 2020/11/12
- [elpa] externals/rec-mode 0f09c3f 33/98: rec-mode: support editing boolean fields as special enum values., Stefan Monnier, 2020/11/12