RCD Version Control system for Emacs is PostgreSQL database backed version control for files, buffers and database column values.
;;; rcd-vc.el --- RCD Version Control system with PostgreSQL backend
;; Copyright (C) 2021 by Jean Louis
;; Author: Jean Louis <bugs@gnu.support>
;; Version: 1.14
;; Package-Requires: (rcd-db-init rcd-db rcd-utilities)
;; Keywords: vc
;; URL: https://hyperscope.link/3/6/7/9/6/emacs-rcd-version-control-system-with-postgresql-backend-36796.html
;; 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 Affero General Public License as published by the Free
;; Software Foundation, either version 3 of the License, or (at your option) any
;; later version.
;;
;; This program is distributed in the hope that it will be useful, but WITHOUT
;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
;; FOR A PARTICULAR PURPOSE. see the GNU Affero General Public License for more
;; details.
;;
;; You should have received a copy of the GNU Affero General Public License
;; along with this program. if not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; RCD is acronym for Reach, Connect, Deliver, my personal
;; principle and formula for Wealth.
;; this may be added to automatically insert revision on killing of
;; the buffer if the buffer file name already exists in the database.
;; (add-hook 'kill-buffer-hook 'rcd-vc-insert-revision-on-kill-buffer)
;; -- PostgreSQL database dump
;; -- Dumped from database version 13.2
;; -- Dumped by pg_dump version 13.2
;;
;; Create table public.vc (
;; vc_id integer NOT NULL,
;; vc_datecreated timestamp WITHOUT TIME ZONE DEFAULT current_timestamp NOT NULL,
;; vc_datemodified timestamp WITHOUT TIME ZONE,
;; vc_usercreated text DEFAULT current_user NOT NULL,
;; vc_usermodified text DEFAULT current_user NOT NULL,
;; vc_table text,
;; vc_column text,
;; vc_tableid integer,
;; vc_value text,
;; vc_signature text,
;; vc_title text,
;; vc_description text,
;; vc_filename text,
;; vc_revision text,
;; vc_buffer boolean DEFAULT false
;; );
;; COMMENT ON table public.vc IS 'version control';
;; COMMENT ON column public.vc.vc_id IS 'id';
;; COMMENT ON column public.vc.vc_datecreated IS 'date created';
;; COMMENT ON column public.vc.vc_datemodified IS 'date modified';
;; COMMENT ON column public.vc.vc_usercreated IS 'user created';
;; COMMENT ON column public.vc.vc_usermodified IS 'user modified';
;; COMMENT ON column public.vc.vc_table IS 'table';
;; COMMENT ON column public.vc.vc_column IS 'column';
;; COMMENT ON column public.vc.vc_tableid IS 'table id';
;; COMMENT ON column public.vc.vc_value IS 'value';
;; COMMENT ON column public.vc.vc_signature IS 'pgp signature';
;; COMMENT ON column public.vc.vc_title IS 'short description';
;; COMMENT ON column public.vc.vc_description IS 'description';
;;
;; CREATE sequence public.vc_vc_id_seq
;; AS integer
;; START WITH 1
;; INCREMENT BY 1
;; no minvalue
;; no maxvalue
;; CACHE 1;
;; ALTER sequence public.vc_vc_id_seq OWNED BY public.vc.vc_id;
;; ALTER table ONLY public.vc ALTER COLUMN vc_id SET default
;; nextval('public.vc_vc_id_seq'::regclass);
;; ALTER table ONLY public.vc
;; ADD constraint vc_pkey primary key (vc_id);
;; CREATE UNIQUE INDEX vc_index ON public.vc USING btree (vc_filename,
;; vc_revision);
;; CREATE TRIGGER insert_username_vc BEFORE INSERT OR UPDATE ON public.vc FOR
;; EACH ROW EXECUTE FUNCTION public.insert_username('vc_usermodified');
;; CREATE TRIGGER vc_moddatetime BEFORE UPDATE ON public.vc FOR EACH ROW EXECUTE
;; FUNCTION public.moddatetime('vc_datemodified');
;; GRANT ALL ON TABLE public.vc TO public;
;;; Change Log:
;;; Code:
;;; Install EMACS PostgreSQL module emacs-libpq
;;; from https://github.com/anse1/emacs-libpq.git
(require 'pq)
(require 'rcd-db-init)
(require 'rcd-db)
(require 'rcd-utilities)
(defvar rcd-vc-database "rcdbusiness")
(defvar rcd-vc-db nil)
(defvar rcd-vc-ask-for-description t)
(defvar rcd-vc-ask-for-revision t)
(defun rcd-vc-connect ()
(if (or (not (boundp 'rcd-vc-db))
(null rcd-vc-db))
(setq rcd-vc-db (rcd-db-connect rcd-vc-database))
rcd-vc-db))
(defvar rcd-vc-ask-for-revision t
"Global decision variable to ask user for revision number.
it will use automatically assigned database id numbers.")
(defvar rcd-vc-title-history nil
"Retains history of revision titles.")
(defun rcd-vc-insert-revision (filename title &optional description revision buffer)
"Insert the revised FILENAME with TITLE into the database.
Optional DESCRIPTION and REVISION may be provided.
Optional argument BUFFER will insert current buffer into the database."
(if buffer
(rcd-vc-insert-revision-1
(concat "Buffer: " (buffer-name))
title description revision (buffer-string) t)
(if (or (file-directory-p filename)
(not (file-exists-p filename))
(not (file-readable-p filename)))
(if (y-or-n-p (concat "Do you wish to record buffer: " (buffer-name)))
(rcd-vc-insert-revision-1
(concat "Buffer: " (buffer-name))
title description revision (buffer-string) t)
(message "Cannot read or access file: %s" filename))
(let ((body (file-to-string filename)))
(rcd-vc-insert-revision-1 filename title description revision body)))))
(defun rcd-vc-insert-revision-1 (filename title description revision body &optional buffer)
"Insert new REVISION into database unconditionally.
asks for arguments FILENAME with TITLE, DESCRIPTION, REVISION
number, and BODY into the database. Optional argument BUFFER
says that FILENAME contains buffer name."
(rcd-vc-connect)
(let* ((original-filename filename)
(filename (sql-escape-string filename))
(title (sql-escape-string title))
(buffer (if buffer "TRUE" "FALSE"))
(description (if description
(sql-escape-string description)
"NULL"))
(revision (if revision
(sql-escape-string revision)
"NULL"))
(body (sql-escape-string body))
(sql (format "INSERT INTO vc
(vc_filename, vc_title, vc_description, vc_value, vc_revision, vc_buffer)
VALUES (%s, %s, %s, %s, %s, %s)
RETURNING vc_id"
filename title description body revision buffer)))
(let ((id (rcd-sql-first sql rcd-vc-db)))
(if id
(message "File revision ID: %s for %s recorded" id original-filename)
(error "Could not record revision for: %s" original-filename)))))
(defun rcd-vc-previous-revision (filename)
"Return previous available revision number if any by using FILENAME."
(rcd-vc-connect)
(let* ((filename (expand-file-name filename))
(filename (sql-escape-string filename))
(sql (format "SELECT vc_revision FROM vc
WHERE vc_filename = %s ORDER BY vc_id DESC LIMIT 1" filename)))
(rcd-sql-first sql rcd-vc-db)))
(defun rcd-vc-previous-revisions-exist-p (filename &optional buffer)
"Return T if previous revisions for FILENAME exist in the database.
Optional argument BUFFER verifies if previous revision exist for
the current buffer without file."
(let* ((filename (if buffer
(concat "Buffer: " filename)
(expand-file-name filename)))
(filename (sql-escape-string filename))
(sql (format "SELECT vc_id FROM vc
WHERE vc_filename = %s ORDER BY vc_id DESC limit 1"
filename)))
(rcd-sql-first sql rcd-vc-db)))
(defun rcd-vc-revision ()
"Record the revision into the database."
(interactive)
(when (buffer-modified-p)
(when (buffer-file-name)
(when (y-or-n-p (format "Save %s?" (expand-file-name (buffer-file-name))))
(save-buffer))))
(let* ((update-title (concat "Update: " (rcd-timestamp)))
(title (read-from-minibuffer "Title: " update-title nil nil 'rcd-vc-title-history))
(description (when rcd-vc-ask-for-description
(if (y-or-n-p "Edit description?")
(read-from-buffer "" (concat "Description of changes for: "
(buffer-file-name)))
nil)))
(revision (when rcd-vc-ask-for-revision
(when (y-or-n-p "Enter revision designation?")
(read-from-minibuffer "Revision designation: "
(rcd-vc-increase-decimal-revision-number 0.01)
(rcd-vc-previous-revision (buffer-file-name)))
))))
(filename (if (buffer-file-name)
(expand-file-name (buffer-file-name))
(concat "Buffer: " (buffer-file-name)))))
(rcd-vc-insert-revision filename title description revision)))
;; TODO if user enters revision same as one of previous, need to get a
;; warning that it is same
(defun rcd-vc-insert-revision-on-kill-buffer-buffer ()
"Insert revision in the database on `kill-buffer'."
(let* ((filename (buffer-name))
(timestamp (rcd-timestamp))
(title (concat "Automatic revision: " timestamp)))
(when filename
(when (rcd-vc-previous-revisions-exist-p filename)
(rcd-vc-insert-revision filename title)))))
(defun rcd-vc-insert-revision-on-kill-buffer-filename ()
"Insert revision in the database by using variable `buffer-file-name'."
(let* ((filename (expand-file-name (buffer-file-name)))
(timestamp (rcd-timestamp))
(title (concat "Automatic revision: " timestamp)))
(when filename
(when (rcd-vc-previous-revisions-exist-p filename)
(rcd-vc-insert-revision filename title)))))
(defun rcd-vc-insert-revision-on-kill-buffer ()
"Insert revision in the database on `kill-buffer'.
It does not insert buffer body without file name."
(when (buffer-file-name)
(rcd-vc-insert-revision-on-kill-buffer-filename)))
(defun rcd-vc-revision-in-buffer (id)
"Displays revision in a new buffer. New file name is associated
with this buffer, major mode is guessed by its file name."
(let* ((filename (rcd-db-get-entry "vc" "vc_filename" id rcd-vc-db))
(filename-base (file-name-nondirectory filename))
(directory (file-name-directory filename))
(filename-revised (format "%sRCD-VC-Revision-ID-%s-%s" directory id filename-base))
(body (rcd-db-get-entry "vc" "vc_value" id rcd-vc-db))
(source-buffer (current-buffer))
(buffer (get-buffer-create (format "Revision ID: %s; %s" id filename))))
(switch-to-buffer buffer)
(setq-local buffer-file-name filename-revised)
(read-only-mode 0)
(insert body)
(goto-char 1)
(set-auto-mode)
;; (setq-local buffer-file-name nil)
(set-buffer-modified-p nil)
(read-only-mode 1)
(switch-to-buffer source-buffer)
buffer))
(defun rcd-vc-view-revision (id)
(switch-to-buffer (rcd-vc-revision-in-buffer id)))
(defun rcd-vc-list-revisions ()
"List revisions of the file and allows user to display revision
in a buffer."
(interactive)
(if buffer-file-name
(if (rcd-vc-previous-revisions-exist-p buffer-file-name)
(let* ((filename buffer-file-name)
(filename-escaped (sql-escape-string filename))
(revision (rcd-vc-select-revision buffer-file-name)))
(rcd-vc-view-revision revision))
(when (y-or-n-p "This file is not under version control. Record?")
(rcd-vc-revision)))))
(defun rcd-vc-select-revision (filename)
"List revisions available for FILENAME."
(rcd-vc-connect)
(let* ((filename (expand-file-name filename))
(filename-escaped (sql-escape-string filename))
(sql (format "SELECT vc_id FROM vc WHERE vc_filename = %s LIMIT 1" filename-escaped)))
(if (rcd-sql-first sql rcd-vc-db)
(let* ((sql (format
"SELECT vc_id, vc_filename || 'ID: ' || lpad(vc_id::text, 5, '0')
FROM vc WHERE vc_filename = %s ORDER BY vc_id"
filename-escaped)) ;; TODO lpad has to be improved
(revision (rcd-completing-read-sql-hash "Revision: " sql rcd-vc-db)))
revision)
(rcd-warning-message "RCD VC: File not registered in version control: %s" filename))))
(defun rcd-vc-diff-buffer-with-revision ()
(interactive)
(if buffer-file-name ;; TODO solve if no file
(let* ((filename (expand-file-name buffer-file-name))
(revision (rcd-vc-select-revision filename)))
(if revision ;; TODO solve if no revision
(let ((buffer (rcd-vc-revision-in-buffer revision)))
(diff-buffers buffer (current-buffer)))))))
(defun rcd-vc-list-of-files (&optional prompt)
(rcd-vc-connect)
(let ((sql "SELECT distinct on (vc_filename) vc_id, vc_filename
FROM vc WHERE vc_filename IS NOT NULL ORDER BY vc_filename")
(prompt (or prompt "Select file in the database: ")))
(rcd-completing-read-sql-hash prompt sql rcd-vc-db)))
(defun rcd-vc-file-of-id (id)
(rcd-db-get-entry "vc" "vc_filename" id rcd-vc-db))
(defun rcd-vc-remove-file-from-database ()
(interactive)
(rcd-vc-connect)
(let* ((id (rcd-vc-list-of-files "Select file to be removed from database: "))
(file (rcd-vc-file-of-id id))
(original file)
(file (sql-escape-string file))
(sql (format "DELETE FROM vc WHERE vc_filename = %s AND vc_filename IS NOT NULL" file)))
(when (y-or-n-p
(format "Do you wish to remove %s from database?" original))
(rcd-sql sql rcd-vc-db))))
(defun rcd-vc-db-revision (table column id &optional description)
"Insert database entry into RCD Version Control."
(let* ((value (rcd-db-get-entry table column id rcd-vc-db))
(value (format "%s" value))
(value (sql-escape-string value))
(description (if description (sql-escape-string description) "NULL"))
(sql (format "INSERT into vc (vc_table,
vc_column,
vc_tableid,
vc_value,
vc_description) values ('%s', '%s', %s, %s, %s)
RETURNING vc_id"
table column id value description))
(id (rcd-sql sql *hs*)))
(if id id nil)))
(defun rcd-vc-revision-is-floating-number-p (revision)
"Return T if REVISION is possibly floating number."
(if (string-is-number-p (format "%s" revision))
(let* ((nnnn (split-string (format "%.2f" (string-to-number (format "%s" revision))) "\\."))
(two (length nnnn)))
(when (= two 2)
(let* ((first-is-number (string-is-number-p (car nnnn)))
(second-is-number (string-is-number-p (cadr nnnn))))
(when (and first-is-number second-is-number)
t))))
nil))
(defun rcd-vc-increase-decimal-revision-number (nn.nn)
"Increase the floating number NN.NN provided either as number or
string for 0.01."
(if (rcd-vc-revision-is-floating-number-p nn.nn)
(let* ((nn.nn (format "%s" nn.nn))
(nn.nn (format "%.2f" (string-to-number nn.nn)))
(nn.nn (string-to-number nn.nn)))
(format "%.2f" (+ nn.nn 0.01)))
nn.nn))
(provide 'rcd-vc)
;;; rcd-vc.el ends here
;; Local Variables:
;; rcd-vc-ask-for-revision: t
;; rcd-vc-ask-for-description: nil
;; End:
RCD is acronym for Reach, Connect, Deliver, my personal principle and formula for Wealth.
emacs version-control postgresql vc package database
Copyright © 2021-03-30 11:49:36.395278+02 Jean Marc Louis
This program is free software: you can redistribute it and/or modify it under the terms of the GNU Affero General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version.
This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more details.
You should have received a copy of the GNU Affero General Public License along with this program. If not, see https://www.gnu.org/licenses/.