From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Stefan Monnier Newsgroups: gmane.emacs.devel Subject: Re: [ELPA] New package: rec-mode Date: Sun, 08 Nov 2020 09:02:27 -0500 Message-ID: References: <8lm0yhv9egglrp.fsf@iki.fi> Mime-Version: 1.0 Content-Type: text/plain; charset=iso-8859-1 Content-Transfer-Encoding: quoted-printable Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="14224"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/28.0.50 (gnu/linux) Cc: jemarch@gnu.org, emacs-devel@gnu.org To: Antoine Kalmbach Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane-mx.org@gnu.org Sun Nov 08 15:03:49 2020 Return-path: Envelope-to: ged-emacs-devel@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1kblIK-0003ay-UB for ged-emacs-devel@m.gmane-mx.org; Sun, 08 Nov 2020 15:03:49 +0100 Original-Received: from localhost ([::1]:57130 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1kblIJ-0007qU-Vj for ged-emacs-devel@m.gmane-mx.org; Sun, 08 Nov 2020 09:03:48 -0500 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]:47514) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1kblHC-0007Hj-FF for emacs-devel@gnu.org; Sun, 08 Nov 2020 09:02:39 -0500 Original-Received: from mailscanner.iro.umontreal.ca ([132.204.25.50]:8675) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1kblH7-00057a-G6; Sun, 08 Nov 2020 09:02:38 -0500 Original-Received: from pmg1.iro.umontreal.ca (localhost.localdomain [127.0.0.1]) by pmg1.iro.umontreal.ca (Proxmox) with ESMTP id 448BF10025B; Sun, 8 Nov 2020 09:02:32 -0500 (EST) Original-Received: from mail01.iro.umontreal.ca (unknown [172.31.2.1]) by pmg1.iro.umontreal.ca (Proxmox) with ESMTP id 76D3810023D; Sun, 8 Nov 2020 09:02:28 -0500 (EST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=iro.umontreal.ca; s=mail; t=1604844148; bh=zfid+gJ1HMHplJSMP6NyNbgf0hquQvq4OUrKnFj5jts=; h=From:To:Cc:Subject:References:Date:In-Reply-To:From; b=EqqDBRZ9/ZRAIGby/zHlu9EShIO/0kvyWSBGXmCYWVUsDf0MLg5zFRqqtO3zoHuAG n8UYK90495EFJ8A5AICnBTA/1xOjptHblSDLZWjjiRCjtWKrDSVMSzhvPtIVKyUom6 AeM1OAjjAH0iEvD7U1jkcXCX6wwojvAV7Ec4m7A0VNQ7UNjs+fiC7rlGkeUIXRaTbx k7P9+zk44cFVx3Mt4ckJCnZ4YbCYwY/QdEXD5Q1WIss9bM/lq0q5j0Qtlg5OnpYC5f +4ykuMI+BIKOsApv+GQKsKnVon9CnpPn9zt4CTGLDeXx7/UYRLwA5IpD7zp6byfXwo amKtrtqjYw0xQ== Original-Received: from alfajor (unknown [157.52.9.240]) by mail01.iro.umontreal.ca (Postfix) with ESMTPSA id 30EAE1202EE; Sun, 8 Nov 2020 09:02:28 -0500 (EST) In-Reply-To: <8lm0yhv9egglrp.fsf@iki.fi> (Antoine Kalmbach's message of "Sun, 08 Nov 2020 12:56:10 +0200") Received-SPF: pass client-ip=132.204.25.50; envelope-from=monnier@iro.umontreal.ca; helo=mailscanner.iro.umontreal.ca X-detected-operating-system: by eggs.gnu.org: First seen = 2020/11/08 08:39:36 X-ACL-Warn: Detected OS = Linux 2.2.x-3.x [generic] X-Spam_score_int: -42 X-Spam_score: -4.3 X-Spam_bar: ---- X-Spam_report: (-4.3 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, RCVD_IN_DNSWL_MED=-2.3, SPF_HELO_NONE=0.001, SPF_PASS=-0.001 autolearn=ham autolearn_force=no X-Spam_action: no action X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.23 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane-mx.org@gnu.org Original-Sender: "Emacs-devel" Xref: news.gmane.io gmane.emacs.devel:258901 Archived-At: >> That's going to be inconvenient unless you keep it in a separate branch >> (otherwise, you can't just push/pull between elpa.git and recutils.git, >> so you end up fighting to convince Git to keep the history of >> rec-mode.el without bringing along all the history of recutils, plus >> ignore all the other files plus remember that `etc/rec-mode.el` in one >> is just `rec-mode.el` in the other, etc...). > > Understood. We will create a rec-mode.git separate from recutils.git and > then just push to an external ref on ELPA. That'd be great, thanks. It can also be a separate branch within the recutils.git, but either way works just fine. > Ok. I'll see how far I can get, we could probably start with a > `Package-Version: 0' initially and then iron out any kinks before it's > released. See patch below if you want some inspiration. > Do we need push rights to elpa.git to be able to push to the > external ref? Yes. Or you can push to some other branch (e.g. recutils.git or rec-mode.git) and then prod someone (such as yours truly) to do the push for you. > I checked with Jose E. Marchesi, GNU recutils doesn't require FSF > assignment. Do we need to do anything special about the Elisp > contributions, or there any problems with this? No, you just have to be careful when you receive contributions to rec-mode.el to remember that this part does require an FSF assignment. Stefan diff --git a/etc/ob-rec.el b/etc/ob-rec.el index c4e1fc8..90d22a3 100644 --- a/etc/ob-rec.el +++ b/etc/ob-rec.el @@ -1,4 +1,4 @@ -;;; ob-rec.el --- org-babel functions for recutils evaluation +;;; ob-rec.el --- org-babel functions for recutils evaluation -*- lexical= -binding: t; -*- =20 ;; Copyright (C) 2011-2019 Free Software Foundation =20 @@ -25,7 +25,16 @@ ;; contained template. See http://www.gnu.org/software/recutils/ =20 ;;; Code: -(require 'ob) +;; (require 'ob) + +;; FIXME: `org-babel-trim' was renamed `org-trim' in Org-9.0! +(declare-function org-babel-trim "org-compat" (s &optional keep-lead)) + +;; FIXME: Presumably `org-babel-execute:rec' will only be called by +;; org-babel, so it's OK to call `org-babel-trim', but what +;; makes us so sure that `org-table' will be loaded by then as well? +(declare-function org-table-convert-region "org-table" (beg0 end0 &optiona= l separator)) +(declare-function org-table-to-lisp "org-table" (&optional txt)) =20 (defvar org-babel-default-header-args:rec '((:exports . "results"))) @@ -33,22 +42,28 @@ (defun org-babel-execute:rec (body params) "Execute a block containing a recsel query. This function is called by `org-babel-execute-src-block'." - (let* ((in-file ((lambda (el) - (or el - (error - "rec code block requires :data header argument")= )) - (cdr (assoc :data params)))) + (let* ((in-file (let ((el (cdr (assoc :data params)))) + (or el + (error + "rec code block requires :data header argument"))= )) (result-params (cdr (assq :result-params params))) - (cmdline (cdr (assoc :cmdline params))) + ;; (cmdline (cdr (assoc :cmdline params))) (rec-type (cdr (assoc :type params))) (fields (cdr (assoc :fields params))) (join (cdr (assoc :join params))) (sort (cdr (assoc :sort params))) (groupby (cdr (assoc :groupby params))) + ;; Why not make this a *list* of strings, so we can later just map + ;; `shell-quote-argument' over all its elements? + ;; And if `do-raw' is selected we don't even need that because we= can + ;; use `call-process'. (cmd (concat "recsel" (when rec-type (concat " -t " rec-type " ")) + ;; FIXME: Why `expand-file-name'? + ;; FIXME: Shouldn't this need `shell-quote-argument'? " " (expand-file-name in-file) (when (> (length (org-babel-trim body)) 0) + ;; FIXME: Shouldn't this use `shell-quote-argument'? (concat " -e " "\"" (replace-regexp-in-string "\"" "\\\\\"" bo= dy) "\"")) diff --git a/etc/rec-mode.el b/etc/rec-mode.el index b91c91f..5d223e0 100644 --- a/etc/rec-mode.el +++ b/etc/rec-mode.el @@ -1,9 +1,10 @@ -;;; rec-mode.el --- Major mode for viewing/editing rec files +;;; rec-mode.el --- Major mode for viewing/editing rec files -*- lexical-= binding: t; -*- =20 -;; Copyright (C) 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, -;; 2018, 2019, 2020 Jose E. Marchesi +;; Copyright (C) 2009-2020 Free Software Foundation, Inc. =20 -;; Maintainer: Jose E. Marchesi +;; Maintainer: Jose E. Marchesi +;; Package-Requires: ((emacs "25")) +;; Version: 0 =20 ;; This file is NOT part of GNU Emacs. =20 @@ -32,7 +33,7 @@ ;;; Code: =20 (require 'compile) -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) (require 'calendar) (require 'hl-line) (require 'tabulated-list) @@ -47,19 +48,16 @@ (defcustom rec-open-mode 'navigation "Default mode to use when switching a buffer to rec-mode. Valid values are `edit' and `navigation'. The default is `navigation'" - :type 'symbol - :group 'rec-mode) + :type 'symbol) =20 (defcustom rec-popup-calendar t "Whether to use a popup calendar to select dates when editing field values. The default is `t'." - :type 'boolean - :group 'rec-mode) + :type 'boolean) =20 (defcustom rec-mode-hook nil "Hook run when entering rec mode." - :type 'hook - :group 'rec-mode) + :type 'hook) =20 (defvar rec-max-lines-in-fields 15 "Values of fields having more than the specified lines will be @@ -74,9 +72,9 @@ hidden by default in navigation mode.") (defvar rec-recfix "recfix" "Name of the 'recfix' utility from the GNU recutils.") =20 -(defface rec-field-name-face '((t :weight bold)) "" :group 'rec-mode) -(defface rec-keyword-face '((t :weight bold)) "" :group 'rec-mode) -(defface rec-continuation-line-face '((t :weight bold)) "" :group 'rec-mod= e) +(defface rec-field-name-face '((t :weight bold)) "") +(defface rec-keyword-face '((t :weight bold)) "") +(defface rec-continuation-line-face '((t :weight bold)) "") =20 ;;;; Variables and constants that the user does not want to touch (really!) =20 @@ -139,16 +137,21 @@ hidden by default in navigation mode.") (let ((st (make-syntax-table))) (modify-syntax-entry ?# "<" st) ; Comment start (modify-syntax-entry ?\n ">" st) ; Comment end - (modify-syntax-entry ?\" "w" st) - (modify-syntax-entry ?\' "w" st) + (modify-syntax-entry ?\" "w" st) ;FIXME: really? Why? + (modify-syntax-entry ?\' "w" st) ;FIXME: really? Why? st) "Syntax table used in rec-mode") =20 +(defconst rec-syntax-propertize-function + (syntax-propertize-rules + ;; In rec, `#' only starts a comment when at BOL. + (".\\(#\\)" (1 ".")))) + (defvar rec-font-lock-keywords -`((,(concat "^" rec-keyword-prefix "[a-zA-Z0-9_]+:") . rec-field-name-face) - (,rec-field-name-re . rec-keyword-face) - ("^\\+" . rec-continuation-line-face)) -"Font lock keywords used in rec-mode") + `((,(concat "^" rec-keyword-prefix "[a-zA-Z0-9_]+:") . rec-field-name-fa= ce) + (,rec-field-name-re . rec-keyword-face) + ("^\\+" . rec-continuation-line-face)) + "Font lock keywords used in rec-mode") =20 (defvar rec-mode-edit-map (let ((map (make-sparse-keymap))) @@ -225,18 +228,16 @@ including the leading #: (comment POSITION \"# foo\") =20 If the point is not at the beginning of a comment then return nil" - (let ((there (point)) - comment) - (when (and (equal (current-column) 0) - (looking-at rec-comment-re)) - (setq comment (list 'comment - there - (buffer-substring-no-properties (match-beginning= 0) - (match-end 0)))) + (when (and (equal (current-column) 0) + (looking-at rec-comment-re)) + (let ((comment (list 'comment + (point) + (buffer-substring-no-properties (match-beginning = 0) + (match-end 0))))) (goto-char (match-end 0)) ;; Skip a newline if needed - (when (looking-at "\n") (goto-char (match-end 0)))) - comment)) + (when (eolp) (forward-line 1)) + comment))) =20 (defun rec-parse-field-name () "Parse and return a field name starting at point. @@ -266,7 +267,7 @@ nil" (with-temp-buffer (insert val) (goto-char (point-min)) - (if (equal (char-after (point)) ? ) + (if (equal (char-after (point)) ?\s) (progn (delete-char 1))) (setq val (buffer-substring-no-properties (point-min) @@ -411,18 +412,18 @@ If no such field exists in RECORD then nil is returne= d." ;; Those functions retrieve or set properties of comment structures. =20 (defun rec-comment-p (comment) - "Determine if the provided structure is a comment" + "Determine if the provided COMMENT arg is a comment structure." (and (listp comment) (=3D (length comment) 3) (equal (car comment) 'comment))) =20 (defun rec-comment-position (comment) - "Return the start position of the given comment." + "Return the start position of the given COMMENT." (when (rec-comment-p comment) (nth 1 comment))) =20 (defun rec-comment-string (comment) - "Return the string composig the comment, including the initial '#' chara= cter." + "Return the string composing the COMMENT, including the initial '#' char= acter." (when (rec-comment-p comment) (nth 2 comment))) =20 @@ -471,10 +472,7 @@ If no such field exists in RECORD then nil is returned= ." (match-end 0))) (goto-char (point-max)) (setq c (char-before)) - (while (and c - (or (equal c ?\n) - (equal c ?\t) - (equal c ? ))) + (while (and c (member c '(?\n ?\t ?\s))) (backward-char) (setq c (char-before))) (delete-region (point) (point-max)) @@ -493,18 +491,18 @@ If no such field exists in RECORD then nil is returne= d." nil if the pointer is not on a field." (save-excursion (beginning-of-line) - (let (res exit) - (while (not exit) - (cond - ((and (not (=3D (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)))) + (let (res) + (while + (cond + ((and (not (=3D (line-beginning-position) 1)) + (or (looking-at "+") + (looking-back "\\\\\n" 2))) + (forward-line -1) + t) ;;Continue + ((looking-at rec-field-name-re) + (setq res (point)) + nil) ;;Exit + (t nil))) ;;Exit res))) =20 (defun rec-end-of-field-pos () @@ -544,11 +542,10 @@ or nil if the pointer is not on a comment." "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)) + (let (field-pos) (while (and (not (equal (point) (point-min))) - (or (setq field-pos (rec-beginning-of-field-pos)) - (setq field-pos (rec-beginning-of-comment-pos)))) + (setq field-pos (or (rec-beginning-of-field-pos) + (rec-beginning-of-comment-pos)))) (goto-char field-pos) (if (not (equal (point) (point-min))) (backward-char))) @@ -619,6 +616,17 @@ The current record is the record where the pointer is" ;; These functions perform the management of the collection of records ;; in the buffer. =20 +;; FIXME: The term "descriptor" is used for this object as well as for its +;; first field, which is confusing. +(cl-defstruct (rec--descriptor + (:constructor nil) + (:constructor rec--descriptor-make (descriptor marker))) + descriptor marker) + +(defvar rec-buffer-descriptors nil + "List of `rec--descriptor's.") +(make-variable-buffer-local 'rec-buffer-descriptors) + (defun rec-buffer-valid-p () "Determine whether the current buffer contains valid rec data." (equal (call-process-region (point-min) (point-max) @@ -626,7 +634,8 @@ The current record is the record where the pointer is" nil ; delete nil ; discard output nil ; display - ) 0)) + ) + 0)) =20 (defun rec-update-buffer-descriptors-and-check (&optional dont-go-fundamen= tal) "Update buffer descriptors and switch to fundamental mode if @@ -663,16 +672,17 @@ there is a parse error." If the contents of the current buffer are not valid rec data then this function returns `nil'." (setq rec-buffer-descriptors - (let ((buffer (generate-new-buffer "Rec Inf ")) - descriptors records status) - ;; Call 'recinf' to get the list of record descriptors in - ;; sexp format. - (setq status (call-process-region (point-min) (point-max) - rec-recinf - nil ; delete - buffer - nil ; display - "-S" "-d")) + (let* ((buffer (generate-new-buffer "Rec Inf ")) + descriptors records + (status + ;; Call 'recinf' to get the list of record descriptors in + ;; sexp format. + (call-process-region (point-min) (point-max) + rec-recinf + nil ; delete + buffer + nil ; display + "-S" "-d"))) (if (equal status 0) (progn (with-current-buffer buffer (goto-char (point-min)) @@ -684,10 +694,17 @@ this function returns `nil'." (kill-buffer buffer))) (when descriptors (mapc (lambda (descriptor) - (let ((marker (make-marker))) - (set-marker marker (rec-record-position d= escriptor)) - (setq records (cons (list 'descriptor des= criptor marker) - records)))) + ;; FIXME: The `rec-record-position' data co= mes + ;; from the `recinf' tool. Are these posit= ions + ;; counted in bytes or characters? Do they + ;; count positions starting from 0 or from = 1? + (let ((marker (copy-marker + (rec-record-position descrip= tor)))) + ;; FIXME: Why do we need `marker' if the = buffer + ;; position is already contained in + ;; `descriptor'? + (push (rec--descriptor-make descriptor ma= rker) + records))) descriptors) (reverse records))) (kill-buffer buffer) @@ -700,7 +717,7 @@ existing buffer." ;; used. The rest are ignored. (mapcar (lambda (elem) - (car (rec-record-assoc rec-keyword-rec (cadr elem)))) + (car (rec-record-assoc rec-keyword-rec (rec--descriptor-descriptor el= em)))) rec-buffer-descriptors)) =20 (defun rec-type-p (type) @@ -736,10 +753,10 @@ this function returns nil." (mapc (lambda (elem) (when (equal (car (rec-record-assoc rec-keyword-rec - (cadr elem))) + (rec--descriptor-descriptor e= lem))) type) (setq found t) - (goto-char (nth 2 elem)))) + (goto-char (rec--descriptor-marker elem)))) descriptors) found))) =20 @@ -875,9 +892,9 @@ Return nil otherwise." If the record is of no known type, return nil." (let ((descriptor (rec-record-descriptor))) (cond - ((listp descriptor) + ((rec--descriptor-p descriptor) (car (rec-record-assoc rec-keyword-rec - (cadr descriptor)))) + (rec--descriptor-descriptor descriptor)))) ((equal descriptor "") "") (t @@ -890,12 +907,13 @@ Return \"\" if no proper record descriptor is found i= n 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 + descriptor position found (i 0)) + ;; FIXME: length+nth on every iteration means O(N=B2) for no good re= ason! (while (and (not found) (< i (length descriptors))) (setq descriptor (nth i rec-buffer-descriptors)) - (setq position (marker-position (nth 2 descriptor))) + (setq position (marker-position (rec--descriptor-marker descriptor= ))) (if (and (>=3D (point) position) (or (=3D i (- (length rec-buffer-descriptors) 1)) (< (point) (marker-position (nth 2 (nth (+ i 1) rec-b= uffer-descriptors)))))) @@ -908,7 +926,7 @@ Return nil if the point is not on a record." (defun rec-summary-fields () "Return a list with the names of the summary fields in the current record set." - (let ((descriptor (cadr (rec-record-descriptor)))) + (let ((descriptor (rec--descriptor-descriptor (rec-record-descriptor)))) (when descriptor (let ((fields-str (rec-record-assoc rec-keyword-summary descriptor))) (when fields-str @@ -917,7 +935,7 @@ current record set." (defun rec-mandatory-fields () "Return a list with the names of the mandatory fields in the current record set." - (let ((descriptor (cadr (rec-record-descriptor)))) + (let ((descriptor (rec--descriptor-descriptor (rec-record-descriptor)))) (when descriptor (let ((fields-str (rec-record-assoc rec-keyword-mandatory descriptor= ))) (when fields-str @@ -926,11 +944,9 @@ current record set." (defun rec-key () "Return the name of the field declared as the key of the current record set, if any. Otherwise return `nil'." - (let ((descriptor (cadr (rec-record-descriptor)))) + (let ((descriptor (rec--descriptor-descriptor (rec-record-descriptor)))) (when descriptor - (let ((key (rec-record-assoc rec-keyword-key descriptor))) - (when key - (car key)))))) + (car (rec-record-assoc rec-keyword-key descriptor))))) =20 ;;;; Navigation =20 @@ -993,7 +1009,7 @@ current buffer to look like indentation." =20 (defun rec-remove-continuation-line-marker-overlays () "Delete all the continuation line markers overlays." - (mapc 'delete-overlay rec-continuation-line-markers-overlays) + (mapc #'delete-overlay rec-continuation-line-markers-overlays) (setq rec-continuation-line-markers-overlays nil)) =20 ;;;; Field folding @@ -1012,8 +1028,7 @@ the visibility." (when (rec-field-p field) (let ((lines-in-value (with-temp-buffer (insert (rec-field-value field)) - (count-lines (point-min) (point-max)))) - ov) + (count-lines (point-min) (point-max))))) (when (> lines-in-value rec-max-lines-in-fields) (save-excursion (goto-char (rec-field-position field)) @@ -1057,7 +1072,7 @@ the visibility." =20 (defun rec-unfold-all-fields () "Unfold all folded fields in the buffer." - (mapc 'delete-overlay rec-hide-field-overlays) + (mapc #'delete-overlay rec-hide-field-overlays) (setq rec-hide-field-overlays nil)) =20 (defun rec-unfold-record-fields () @@ -1086,10 +1101,8 @@ the visibility." (eq (overlay-get overlay 'invisible) 'rec-hide-field)) (overlays-at value-start))) - (mapcar - (lambda (overlay) - (delete-overlay overlay)) - (overlays-at value-start)) + (mapcar #'delete-overlay + (overlays-at value-start)) (setq ov (make-overlay value-start value-end)) (overlay-put ov 'invisible 'rec-hide-field)))))))) =20 @@ -1126,108 +1139,101 @@ the visibility." ;; ;; - For any other type, it is nil. =20 -(defvar rec-types +(cl-defstruct (rec-type + (:predicate nil) ;Don't override the `rec-type-p' a= bove! + (:constructor nil) + (:constructor rec-type--create (kind text data)) + (:type list)) + (-head 'type) + kind text data) + +(defvar rec-types ;FIXME: Shouldn't this be `defcons= t'? '("int" "bool" "range" "real" "size" "line" "regexp" "date" "enum" "fiel= d" "email" "uuid" "rec") "Kind of supported types") =20 (defun rec-type-kind-p (kind) "Determine whether the given symbol or string is a type kind." - (let (kind-symbol) - (cond - ((symbolp kind) - (member (symbol-name kind) rec-types)) - ((stringp kind) - (member kind rec-types)) - (t - nil)))) + (cond + ((symbolp kind) + (member (symbol-name kind) rec-types)) + ((stringp kind) + (member kind rec-types)) + (t + nil))) =20 (defun rec-parse-type (str) "Parse STR into a new type structure and return it. =20 STR must contain a type description as defined in the recutils manual." - (let (type) - (with-temp-buffer - (insert str) - (goto-char (point-min)) - (when (looking-at "[a-z]+") - (let ((kind (match-string 0))) - (goto-char (match-end 0)) - (when (rec-type-kind-p kind) - (cond - ((member kind '("int" "bool" "real" "line" "date" "field" "em= ail" "uuid")) - (when (looking-at "[ \n\t]*$") - (list 'type (intern kind) str nil))) - ((equal kind "size") - (when (looking-at "[ \n\t]*\\([0-9]+\\)[ \n\t]*$") - (list (intern kind) str (string-to-number (match-string 1)= )))) - ((equal kind "range") - (when (or - (looking-at "[ \n\t]*\\(-?[0-9]+\\)[ \n\t]*$") - (looking-at "[ \n\t]*\\(-?[0-9]+\\)[ \n\t]+\\([0-9]+\= \)[ \n\t]*$")) - (let ((min (string-to-number (match-string 1))) - (max (when (stringp (match-string 2)) - (string-to-number (match-string 2))))) - (list 'type (intern kind) str (list min max))))) - ((equal kind "enum") - (let ((str-copy str) - (here (point))) - ;; Remove comments from the enum description. - (delete-region (point-min) (point-max)) - (insert (replace-regexp-in-string "([^)]*)" "" str-copy)) - (goto-char here) - (when (looking-at "\\([ \n\t]*[a-zA-Z0-9][a-zA-Z0-9_-]*\\)= +[ \n\t]*$") - (let (names) - ;; Scan the enum literals. - (while (looking-at "[ \n\t]+\\([a-zA-Z0-9][a-zA-Z0-9_-= ]*\\)") - (setq names (cons (match-string 1) names)) - (goto-char (match-end 0))) - (list 'type (intern kind) str-copy (reverse names)))))) - ((equal kind "rec") - (when (looking-at "[ \n\t]*\\([a-zA-Z%][a-zA-Z0-9_]*\\)[ \n\= t]*$") ; Field name without a colon. - (let ((referred-record (match-string 1))) - (list 'type (intern kind) str referred-record)))) - ((equal kind "regexp") - (when (looking-at "[ \n\t]*\\(.*?\\)[ \n\t]*$") - (let ((expr (match-string 1))) - (when (and (>=3D (length expr) 2) - (equal (elt expr 0) (elt expr (- (length expr= ) 1)))) - (list 'type (intern kind) str (substring expr 1 -1))))= )) - (t - nil)))))))) - -(defun rec-type-kind (type) - "Return the kind of a given type." - (cadr type)) - -(defun rec-type-data (type) - "Return the data associated with a given type." - (cadddr type)) - -(defun rec-type-text (type) - "Return the textual description of a given type." - (caddr type)) + (with-temp-buffer + (insert str) + (goto-char (point-min)) + (when (looking-at "[a-z]+") + (let ((kind (match-string 0))) + (goto-char (match-end 0)) + (when (rec-type-kind-p kind) + (cond + ((member kind '("int" "bool" "real" "line" "date" "field" "emai= l" "uuid")) + (when (looking-at "[ \n\t]*$") + (rec-type--create (intern kind) str nil))) + ((equal kind "size") + (when (looking-at "[ \n\t]*\\([0-9]+\\)[ \n\t]*$") + ;; FIXME: A missing `'type'? Should it call `rec-type--crea= te'? + (list (intern kind) str (string-to-number (match-string 1)))= )) + ((equal kind "range") + (when (or + (looking-at "[ \n\t]*\\(-?[0-9]+\\)[ \n\t]*$") + (looking-at "[ \n\t]*\\(-?[0-9]+\\)[ \n\t]+\\([0-9]+\\)= [ \n\t]*$")) + (let ((min (string-to-number (match-string 1))) + (max (when (stringp (match-string 2)) + (string-to-number (match-string 2))))) + (rec-type--create (intern kind) str (list min max))))) + ((equal kind "enum") + (let ((str-copy str) + (here (point))) + ;; Remove comments from the enum description. + (delete-region (point-min) (point-max)) + (insert (replace-regexp-in-string "([^)]*)" "" str-copy)) + (goto-char here) + (when (looking-at "\\([ \n\t]*[a-zA-Z0-9][a-zA-Z0-9_-]*\\)+[= \n\t]*$") + (let (names) + ;; Scan the enum literals. + (while (looking-at "[ \n\t]+\\([a-zA-Z0-9][a-zA-Z0-9_-]*= \\)") + (setq names (cons (match-string 1) names)) + (goto-char (match-end 0))) + (rec-type--create (intern kind) str-copy (reverse names)= ))))) + ((equal kind "rec") + (when (looking-at "[ \n\t]*\\([a-zA-Z%][a-zA-Z0-9_]*\\)[ \n\t]= *$") ; Field name without a colon. + (let ((referred-record (match-string 1))) + (rec-type--create (intern kind) str referred-record)))) + ((equal kind "regexp") + (when (looking-at "[ \n\t]*\\(.*?\\)[ \n\t]*$") + (let ((expr (match-string 1))) + (when (and (>=3D (length expr) 2) + (equal (elt expr 0) (elt expr (- (length expr) = 1)))) + (rec-type--create (intern kind) str (substring expr 1 -1= )))))) + (t + nil))))))) =20 (defun rec-check-type (type str) "Check whether STR contains a value conforming to TYPE, which is a field type structure." - (let* ((kind (cadr type)) - (expr (caddr type)) - (data (cadddr type)) - (value (if (equal kind 'line) - str - str))) + (let* ((kind (rec-type-kind type)) + ;; (expr (rec-type-text type)) + (data (rec-type-data type)) + (value str)) (cond ((equal kind 'int) - (string-match-p "^-?[0-9]+$" value)) + (string-match-p "\\`-?[0-9]+\\'" value)) ((equal kind 'bool) (string-match-p "^\\(yes\\|no\\|0\\|1\\|true\\|false\\)$" value)) ((equal kind 'range) (let ((min (car data)) (max (cadr data))) - (when (looking-at "-?[0-9]+$") + (when (looking-at "-?[0-9]+$") ;FIXME: `type' relates to text at p= oint? (let ((number (string-to-number (match-string 0)))) - (and (>=3D number min) (<=3D number max)))))) + (and (>=3D number min) (<=3D number max)))))) ((equal kind 'real) (string-match-p "^-?\\([0-9]*\\.\\)?[0-9]+$" value)) ((equal kind 'size) @@ -1242,9 +1248,12 @@ is a field type structure." ((equal kind 'enum) (member value data)) ((equal kind 'field) - (string-match-p "^[a-zA-Z%][a-zA-Z0-9_]*$" value)) + ;; FIXME: [:alnum:]? + (string-match-p "\\`[a-zA-Z%][a-zA-Z0-9_]*\\'" value)) ((equal kind 'email) - (string-match-p "^[a-zA-Z0-9._%+-]+@[a-zA-Z0-9.-]+\\.[a-zA-Z]+$" val= ue)) + ;; FIXME: [:alnum:]? + (string-match-p "\\`[a-zA-Z0-9._%+-]+@[a-zA-Z0-9.-]+\\.[a-zA-Z]+\\'" + value)) ((equal kind 'uuid) ;; TODO. t) @@ -1260,7 +1269,8 @@ the current record set. If the field has no type, i.= e. it is an unrestricted field which can contain any text, then `nil' is returned." (let* ((descriptor (rec-record-descriptor)) - (types (rec-record-assoc "%type" (cadr descriptor))) + (types (rec-record-assoc "%type" + (rec--descriptor-descriptor descriptor))) res-type) ;; Note that invalid %type entries are simply ignored. (mapc @@ -1269,9 +1279,8 @@ returned." (insert type-descr) (goto-char (point-min)) (when (looking-at "[ \n\t]*\\([a-zA-Z%][a-zA-Z0-9_-]*\\(,[a-zA-Z%= ][a-zA-Z0-9_-]*\\)?\\)[ \n\t]*") - (let ((names (match-string 1)) - (begin-description (match-end 0)) - name) + (let (;; (names (match-string 1)) + (begin-description (match-end 0))) (goto-char (match-beginning 1)) (while (looking-at "\\([a-zA-Z%][a-zA-Z0-9_]*\\),?") (if (equal (match-string 1) field-name) @@ -1307,16 +1316,19 @@ NAMES is an association list of the form: 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)) + (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) + name count result char key-list) (save-window-excursion (set-buffer (get-buffer-create " *Rec Fast Selection*")) (delete-other-windows) -;; (split-window-vertically) + ;; (split-window-vertically) + ;; FIXME: This `switch-to-buffer-other-window' can pop up a new fram= e, + ;; which `save-window-excursion' won't undo at the end! (switch-to-buffer-other-window (get-buffer-create " *Rec Fast Select= ion*")) (erase-buffer) (insert prompt ":") @@ -1348,6 +1360,9 @@ Each character should identify only one name." =20 ;;;; Summary mode =20 +(defvar rec-marker) +(make-variable-buffer-local 'rec-marker) + (defvar rec-summary-mode-map (let ((map (make-sparse-keymap))) (set-keymap-parent map tabulated-list-mode-map) @@ -1383,9 +1398,8 @@ The data has the same structure than `tabulated-list-= entries'." "Jump to the selected record in the rec-mode buffer." (interactive) ;; (if (buffer-live-p rec-summary-rec-buffer) - (save-excursion - (let ((rec-marker (tabulated-list-get-id))) - (set-buffer (marker-buffer rec-marker)) + (let ((rec-marker (tabulated-list-get-id))) + (with-current-buffer (marker-buffer rec-marker) (widen) (goto-char (marker-position rec-marker)) (rec-show-record)))) @@ -1401,7 +1415,7 @@ The data has the same structure than `tabulated-list-= entries'." ;; Note that the functions are not checking for the integrity of the ;; arguments: it is the invoked recutil which is in charge of that. =20 -(defun* rec-query (&rest args +(cl-defun rec-query (&rest args &key (type nil) (join nil) (index nil) (sex nil) (fast-string nil) (random nil) (fex nil) (password= nil) (group-by nil) (sort-by nil) (icase nil) (uniq nil= )) @@ -1518,10 +1532,19 @@ A prefix argument means to use a case-insensitive s= earch." =20 (defvar rec-field-name) (make-variable-buffer-local 'rec-field-name) -(defvar rec-marker) -(make-variable-buffer-local 'rec-marker) (defvar rec-buffer) (make-variable-buffer-local 'rec-buffer) +(defvar rec-jump-back nil) +(make-variable-buffer-local 'rec-jump-back) +(defvar rec-update-p nil) +(make-variable-buffer-local 'rec-update-p) +(defvar rec-preserve-last-newline nil) +(make-variable-buffer-local 'rec-preserve-last-newline) +(defvar rec-editing nil) +(make-variable-buffer-local 'rec-editing) + +(defvar rec-prev-buffer) ;FIXME: Should it have a global va= lue? +(defvar rec-pointer) ;FIXME: Buffer local? Global valu= e? =20 (defun rec-cmd-edit-field (n) "Edit the contents of the field under point in a separate @@ -1532,8 +1555,7 @@ type, unless a prefix argument is used. Then the mor= e general method, i.e. asking for the new value in an unrestricted buffer, will be used for fields of any type." (interactive "P") - (let* (edit-buf - (field (rec-current-field)) + (let* ((field (rec-current-field)) (field-value (rec-field-value field)) (field-name (rec-field-name field)) (field-type (rec-field-type field-name)) @@ -1542,8 +1564,7 @@ will be used for fields of any type." (prev-buffer (current-buffer))) (if field-value (cond - ((and (or (equal field-type-kind 'enum) - (equal field-type-kind 'bool)) + ((and (member field-type-kind '(enum bool)) (null n)) (let* ((data (rec-type-data field-type)) (fast-selection-data @@ -1579,7 +1600,7 @@ will be used for fields of any type." (error "Invalid kind of type")))) (letter (rec-fast-selection fast-selection-data "New valu= e"))) (when letter - (let ((buffer-read-only nil) + (let ((inhibit-read-only t) new-value) (mapc (lambda (elem) @@ -1598,32 +1619,33 @@ will be used for fields of any type." (setq rec-prev-buffer prev-buffer) (setq rec-pointer pointer) (calendar) - (let ((old-map (current-local-map)) - (map (copy-keymap calendar-mode-map))) + (let ((old-map (current-local-map)) ;Isn't this calendar-mode-ma= p? + (map (make-sparse-keymap))) + (set-keymap-parent map calendar-mode-map) (define-key map "q" - `(lambda () (interactive) - (use-local-map (quote ,old-map)) - (calendar-exit))) + (lambda () (interactive) + (use-local-map old-map) + (calendar-exit))) (define-key map "t" - `(lambda () (interactive) - (use-local-map (quote ,old-map)) - (calendar-exit) - (set-buffer rec-prev-buffer) - (let ((buffer-read-only nil)) - (rec-delete-field) - (save-excursion - (rec-insert-field (list 'field - 0 - rec-field-name - (format-time-string rec-time-= stamp-format))))))) + (lambda () (interactive) + (use-local-map old-map) + (calendar-exit) + (set-buffer rec-prev-buffer) + (let ((inhibit-read-only t)) + (rec-delete-field) + (save-excursion + (rec-insert-field (list 'field + 0 + rec-field-name + (format-time-string rec-time-s= tamp-format))))))) (define-key map (kbd "RET") - `(lambda () (interactive) - (let* ((date (calendar-cursor-to-date)) - (time (encode-time 0 0 0 (nth 1 date) (nth 0 date)= (nth 2 date)))) - (use-local-map (quote ,old-map)) + (lambda () (interactive) + (let* ((date (calendar-cursor-to-date)) + (time (encode-time 0 0 0 (nth 1 date) (nth 0 date) = (nth 2 date)))) + (use-local-map old-map) (calendar-exit) (set-buffer rec-prev-buffer) - (let ((buffer-read-only nil)) + (let ((inhibit-read-only t)) (rec-delete-field) (save-excursion (rec-insert-field (list 'field @@ -1633,19 +1655,19 @@ will be used for fields of any type." (use-local-map map) (message "[RET]: Select date [t]: Time-stamp [q]: Exit"))) (t - (setq edit-buf (get-buffer-create "Rec Edit")) - (set-buffer edit-buf) - (delete-region (point-min) (point-max)) - (rec-edit-field-mode) - (setq rec-field-name field-name) - (setq rec-marker (make-marker)) - (set-marker rec-marker pointer prev-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 use C-c C-c to exit"))) + (let ((edit-buf (get-buffer-create "Rec Edit"))) + (set-buffer edit-buf) + (delete-region (point-min) (point-max)) + (rec-edit-field-mode) + (setq rec-field-name field-name) + (setq rec-marker (make-marker)) + (set-marker rec-marker pointer prev-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 use C-c C-c to exit"= )))) (message "Not in a field")))) =20 (defun rec-finish-editing-field () @@ -1660,7 +1682,7 @@ will be used for fields of any type." (set-window-buffer (selected-window) rec-prev-buffer) (delete-window)) (switch-to-buffer rec-prev-buffer) - (let ((buffer-read-only nil)) + (let ((inhibit-read-only t)) (kill-buffer edit-buffer) (goto-char marker) (rec-delete-field) @@ -1745,7 +1767,7 @@ file. Interactive version." (when (null n) (setq n 1)) (widen) (let ((record-type (rec-record-type))) - (dotimes (i n) + (dotimes (_ n) (if (save-excursion (and (rec-goto-next-rec) (equal (rec-record-type) record-type) @@ -1768,7 +1790,7 @@ the file. Interactive version." (when (null n) (setq n 1)) (widen) (let ((record-type (rec-record-type))) - (dotimes (i n) + (dotimes (_ n) (if (save-excursion (and (rec-goto-previous-rec) (equal (rec-record-type) record-type) @@ -1787,7 +1809,7 @@ the file. Interactive version." (defun rec-cmd-undo () "Undo a change in the buffer when in navigation mode." (interactive) - (let ((buffer-read-only nil)) + (let ((inhibit-read-only t)) (undo))) =20 (defun rec-cmd-jump-back () @@ -1958,7 +1980,7 @@ This command is especially useful with enumerated typ= es." "Trim the value of the field under point, if any." (interactive) (save-excursion - (let ((buffer-read-only nil) + (let ((inhibit-read-only t) (field (rec-current-field))) (setq field (rec-field-trim-value field)) (rec-delete-field) @@ -2039,7 +2061,7 @@ This command is especially useful with enumerated typ= es." (end-pos (rec-end-of-record-pos))) (if (and begin-pos end-pos) (progn - (when (looking-back "^[ \t]*") + (when (looking-back "^[ \t]*" (line-beginning-position)) ;; Delete the newline before the record as well, but do ;; not include it in the kill ring. (delete-region (match-beginning 0) (+ (match-end 0) 1))) @@ -2092,7 +2114,7 @@ the user is prompted." (delete-other-windows) (split-window-vertically 10) (switch-to-buffer buf) - (let ((buffer-read-only nil)) + (let ((inhibit-read-only t)) (delete-region (point-min) (point-max)) (setq rec-summary-rec-buffer rec-buf) (rec-summary-mode) @@ -2120,46 +2142,23 @@ function returns `nil'." ;;;; Definition of modes =20 (defvar font-lock-defaults) -(make-variable-buffer-local 'font-lock-defaults) -(defvar rec-type) -(make-variable-buffer-local 'rec-type) -(defvar rec-buffer-descriptors) -(make-variable-buffer-local 'rec-buffer-descriptors) -(defvar rec-jump-back) -(make-variable-buffer-local 'rec-jump-back) -(defvar rec-update-p) -(make-variable-buffer-local 'rec-update-p) -(defvar rec-preserve-last-newline) -(make-variable-buffer-local 'rec-preserve-last-newline) -(defvar rec-editing) -(make-variable-buffer-local 'rec-editing) (defvar add-log-current-defun-section) -(make-variable-buffer-local 'add-log-current-defun-section) =20 -(defun rec-mode () - "A major mode for editing rec files. - -Commands: -\\{rec-mode-map} - -Turning on rec-mode calls the members of the variable -`rec-mode-hook' with no args, if that value is non-nil." - (interactive) - (kill-all-local-variables) +(define-derived-mode rec-mode nil "Rec" + "A major mode for editing rec files." (widen) ;; Local variables - (setq add-log-current-defun-section #'rec-log-current-defun) - (setq rec-editing nil) - (setq rec-jump-back nil) - (setq rec-update-p nil) - (setq rec-preserve-last-newline nil) - (setq font-lock-defaults '(rec-font-lock-keywords)) + (setq (make-local-variable 'add-log-current-defun-section) + #'rec-log-current-defun) + (setq (make-local-variable 'font-lock-defaults) '(rec-font-lock-keywords= )) + (setq-local syntax-propertize-function rec-syntax-propertize-function) (add-to-invisibility-spec '(rec-hide-field . "...")) - (use-local-map rec-mode-map) - (set-syntax-table rec-mode-syntax-table) - (setq mode-name "Rec") - (setq major-mode 'rec-mode) - (run-hooks 'rec-mode-hook) + + ;; Run some code later (i.e. after running the mode hook and setting the + ;; file-local variables). + (add-hook 'hack-local-variables-hook #'rec--after-major-mode nil t)) + +(defun rec--after-major-mode () ;; Goto the first record of the first type (including the Unknown). ;; If there is a problem (i.e. syntax error) then go to fundamental ;; mode and show the output of recfix in a separated buffer. @@ -2171,8 +2170,7 @@ Turning on rec-mode calls the members of the variable (> (buffer-size (current-buffer)) 0)) (progn (setq buffer-read-only t) - (setq rec-type (car (rec-buffer-types))) - (rec-show-type rec-type)) + (rec-show-type (car (rec-buffer-types)))) ;; Edit mode (use-local-map rec-mode-edit-map) (setq rec-editing t) @@ -2184,16 +2182,8 @@ Turning on rec-mode calls the members of the variable map) "Keymap for rec-edit-field-mode") =20 -(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)) +(define-derived-mode rec-edit-field-mode nil "Rec Edit" + "A major mode for editing rec field values.") =20 ;;;; Miscellaneous utilities =20