Merge branch 'master' of git.framasoft.org:com-informatimago/emacs

Pascal J. Bourguignon [2021-10-05 13:56]
Merge branch 'master' of git.framasoft.org:com-informatimago/emacs
Filename
pjb-emacs.el
pjb-org.el
pjb-page.el
pjb-searches.el
pjb-sources.el
pjb-transpose.el
pjb-unicode.el
pjb-work.el
diff --git a/pjb-emacs.el b/pjb-emacs.el
index ebd6909..bac6d9a 100644
--- a/pjb-emacs.el
+++ b/pjb-emacs.el
@@ -730,7 +730,9 @@ with possible additional arguments `browse-url-xterm-args'."
     (message "Done.")))


-
+(defun pjb-ansi-colorize-buffer ()
+  (interactive)
+  (ansi-color-apply-on-region (point-min) (point-max)))

 (defvar pjb-listing-light "LightBlue"
   "Background color of light listing area.") ;;pjb-listing-light
diff --git a/pjb-org.el b/pjb-org.el
new file mode 100644
index 0000000..0cb1a77
--- /dev/null
+++ b/pjb-org.el
@@ -0,0 +1,182 @@
+;;;; -*- mode:emacs-lisp;coding:utf-8;lexical-binding:t -*-
+;;;;**************************************************************************
+;;;;FILE:               pjb-org.el
+;;;;LANGUAGE:           emacs lisp
+;;;;SYSTEM:             POSIX
+;;;;USER-INTERFACE:     NONE
+;;;;DESCRIPTION
+;;;;
+;;;;    org-mode utilities:
+;;;;
+;;;;    - pjb-org-split-big-blocks splits out big blocks to separate
+;;;;      files that are then included.
+;;;;
+;;;;
+;;;;AUTHORS
+;;;;    <PJB> Pascal J. Bourguignon <pjb@informatimago.com>
+;;;;MODIFICATIONS
+;;;;    2021-10-05 <PJB> Created.
+;;;;BUGS
+;;;;LEGAL
+;;;;    AGPL3
+;;;;
+;;;;    Copyright Pascal J. Bourguignon 2021 - 2021
+;;;;
+;;;;    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/>.
+;;;;**************************************************************************
+
+(require 'cl)
+
+(defun pjb-org-enough-namestring (path base)
+  "Compute a relative path to go to the `PATH' from a `BASE' directory.
+If `PATH' is an absolute pathname,
+then it is reduced to a pathname relative to `BASE'
+else it's returned as is."
+  (let ((separator "/")
+        (here      ".")
+        (back      ".."))
+    (if (string= (subseq path 0 (min 1 (length path))) separator)
+        (let* ((apath  (split-string path separator t))
+               (abase  (split-string base separator t))
+
+               (i      (mismatch apath abase :test (function string=))))
+          (if i
+              (mapconcat (function identity)
+                         (let ((new (or (nthcdr i apath) '(""))))
+                           (dotimes (n (- (length abase) i) new)
+                             (push back new)))
+                         separator)
+              (concat here separator)))
+        path)))
+
+
+(defmacro generate-org-element-reader (&rest fields)
+  `(progn
+     ,@(mapcar (lambda (field)
+		         `(defun ,(intern (format "org-element-%s" field)) (element)
+		            (getf (second element) ,(intern (format ":%s" field)))))
+	           fields)))
+
+(generate-org-element-reader begin end contents-begin contents-end
+	                         name language switches parameters
+			                 post-blank post-affiliated parent value switches number-lines
+			                 preserve-indent retain-labels use-labels label-fmt)
+
+(defun org-element-type (element)
+  (first element))
+
+(defun org-element-subtype (element)
+  (org-element-language element))
+
+(defun pjb-org-make-document-directory (&optional buffer-or-path)
+  "Creates a directory named ${buffer-file-name}-inc
+If it already exist, then signal a warning.
+If it's a file, then signal an error.
+Return the path of the new directory."
+  (cond
+    ((null buffer-or-path)
+     (pjb-org-make-document-directory (current-buffer)))
+    ((bufferp buffer-or-path)
+     (pjb-org-make-document-directory (buffer-file-name buffer-or-path)))
+    ((stringp buffer-or-path)
+     (let ((path (concat (file-name-directory buffer-or-path)
+			             (file-name-base buffer-or-path)
+			             "-inc")))
+       (cond
+	     ((file-directory-p path)
+	      path)
+	     ((file-exists-p path)
+	      (error "file %S already exists" path))
+	     (t
+	      (make-directory path t)
+	      path))))
+    (t
+     (error "Invalid argument, expected a buffer or a path (string), got a %S: %S"
+	        (type-of buffer-or-path) buffer-or-path))))
+
+;; (pjb-org-make-document-directory "/tmp/bar")
+
+(defun pjb-org-random-uuid ()
+  "Return a UUID."
+  ;; code here by Christopher Wellons, 2011-11-18.
+  ;; and editted Hideki Saito further to generate all valid variants for "N" in xxxxxxxx-xxxx-Mxxx-Nxxx-xxxxxxxxxxxx format.
+  (let ((uuidata (md5 (format "%s%s%s%s%s%s%s%s%s%s"
+                              (user-uid)
+                              (emacs-pid)
+                              (system-name)
+                              (user-full-name)
+                              (current-time)
+                              (emacs-uptime)
+                              (garbage-collect)
+                              (buffer-string)
+                              (random)
+                              (recent-keys)))))
+    (format "%s-%s-4%s-%s%s-%s"
+            (substring uuidata 0 8)
+            (substring uuidata 8 12)
+            (substring uuidata 13 16)
+            (format "%x" (+ 8 (random 4)))
+            (substring uuidata 17 20)
+            (substring uuidata 20 32))))
+
+(defun pjb-org-save-element (element name path)
+  (let ((text (buffer-substring (org-element-begin element)
+				                (org-element-end element))))
+    (with-temp-buffer nil
+      (insert  "#### -*- mode:org;coding:utf-8;lexical-binding:t -*-\n\n")
+      (insert (format  "## the %s block\n\n" name))
+      (insert "\n" text "\n\n")
+      (write-file path nil))))
+
+(defun pjb-org-insert-file (path type &optional subtype)
+  "Inserts a #+INCLUDE tag."
+  (insert "\n")
+  (insert (format "#+INCLUDE: %S %s" path type ))
+  (when subtype (insert (format " %s" subtype)))
+  (insert "\n\n"))
+
+(defun pjb-org-split-big-blocks (&optional maxsize)
+  (interactive)
+  (let ((maxsize (or maxsize 2048))
+	    (path (buffer-file-name)))
+    (org-block-map
+     (lambda ()
+       (let* ((element (org-element-at-point))
+	          (size (- (or (org-element-contents-end element)
+			               (org-element-end element))
+		               (or (org-element-contents-begin element)
+			               (org-element-begin element)))))
+	     (message "pjb-org-split-big-blocks point = %s ; name = %S ; subtype = %S" (point) (org-element-name element) (org-element-subtype element))
+	     (when (< maxsize size)
+	       (let* ((dir-path (pjb-org-make-document-directory path))
+				  ;; not yet: we need to clean up the name.
+		          ;; (ele-name (let ((id   (pjb-org-random-uuid))
+                  ;;                 (name (org-element-name element)))
+                  ;;             (if name
+                  ;;                 (format "%s-%s.org" id name)
+                  ;;                 (format "%s.org" id))))
+		          (ele-name (pjb-org-random-uuid))
+		          (ele-path (concat (file-name-as-directory dir-path)
+                                    (format "%s.org" ele-name))))
+	         (pjb-org-save-element element ele-name ele-path)
+	         (delete-region (org-element-begin element) (org-element-end element))
+	         (pjb-org-insert-file (pjb-org-enough-namestring ele-path (file-name-directory path))
+                                  (org-element-type element)
+                                  (org-element-subtype element)))))))))
+
+
+(provide 'pjb-org)
+
+;;;; THE END ;;;;
+
diff --git a/pjb-page.el b/pjb-page.el
index 4a54e6c..9dadaf5 100644
--- a/pjb-page.el
+++ b/pjb-page.el
@@ -76,12 +76,16 @@
   (interactive "p")
   (pjb-set-page-mode-key-bindings on)
   (unless on
-    (normal-mode t)))
+    (let ((view view-mode))
+      (normal-mode t)
+      (when view (view-mode 1)))))

 (defun pjb-narrow-to-page (&optional arg)
   (interactive)
   (narrow-to-page arg)
-  (normal-mode t)
+  (let ((view view-mode))
+    (normal-mode t)
+    (when view (view-mode 1)))
   (pjb-reset-page-mode-key-bindings))

 (defun pm-forward-page (&optional count)
diff --git a/pjb-searches.el b/pjb-searches.el
index a92919c..8524e32 100644
--- a/pjb-searches.el
+++ b/pjb-searches.el
@@ -190,6 +190,7 @@ itesearch=&safe=images"

 (defparameter *acronym-search-url* "http://www.acronymfinder.com/%s.html")
 ;;  "http://www.cygwin.com/acronyms/#%s"
+
 (defun acronym-search (acronym-string)
   (interactive "sAcronym Search: ")
   (browse-url (format *acronym-search-url* acronym-string)))
diff --git a/pjb-sources.el b/pjb-sources.el
index 97ce7d6..cb0d677 100644
--- a/pjb-sources.el
+++ b/pjb-sources.el
@@ -411,7 +411,7 @@ RETURN:      A new string in upper case and dash.
   "
 DO:      From the start to end, converts to upcase all symbols.
          Does not touch string literals, comments starting with ';' and
-         symbols quoted with '|' or with '\'.
+         symbols quoted with '|' or with '\\'.
 "
   (interactive "*r")
   (case-lisp-region start end (function upcase-region))
@@ -422,7 +422,7 @@ DO:      From the start to end, converts to upcase all symbols.
   "
 DO:      From the (point) to (point-max), converts to upcase all symbols.
          Does not touch string literals, comments starting with ';' and
-         symbols quoted with '|' or with '\'.
+         symbols quoted with '|' or with '\\'.
 "
   (interactive "*")
   (upcase-lisp-region (point) (point-max)))
@@ -432,7 +432,7 @@ DO:      From the (point) to (point-max), converts to upcase all symbols.
   "
 DO:      From the start to end, converts to low-case all symbols.
          Does not touch string literals, comments starting with ';' and
-         symbols quoted with '|' or with '\'.
+         symbols quoted with '|' or with '\\'.
 "
   (interactive "*r")
   (case-lisp-region start end (function downcase-region))
@@ -443,7 +443,7 @@ DO:      From the start to end, converts to low-case all symbols.
   "
 DO:      From the (point) to (point-max), converts to lowcase all symbols.
          Does not touch string literals, comments starting with ';' and
-         symbols quoted with '|' or with '\'.
+         symbols quoted with '|' or with '\\'.
 "
   (interactive "*")
   (downcase-lisp-region (point) (point-max)))
diff --git a/pjb-transpose.el b/pjb-transpose.el
index db81413..db78489 100644
--- a/pjb-transpose.el
+++ b/pjb-transpose.el
@@ -106,5 +106,12 @@
     (goto-char (point))
     (activate-mark)))

+(defun rotate-rectangle (start end)
+  (interactive "r")
+  (goto-char (min start end))
+  (picture-insert-rectangle
+   (map 'list (lambda (line) (coerce line 'string))
+        (rotate (rotate (rotate (coerce (picture-snarf-rectangle start end)
+                                        'vector)))))))

 ;;;; THE END ;;;;
diff --git a/pjb-unicode.el b/pjb-unicode.el
index 619fa77..4e661d0 100644
--- a/pjb-unicode.el
+++ b/pjb-unicode.el
@@ -32,14 +32,13 @@
 ;;;;    along with this program.  If not, see <http://www.gnu.org/licenses/>.
 ;;;;**************************************************************************
 (require 'cl)
+(require 'pjb-cl)

 (defparameter *pjb-unicode-maps*
   '((mathematical-monospace ((?0 ?9 #x1d7c6)
                              (?A ?Z #x1d62f)
                              (?a ?z #x1d629)))))

-
-
 (defun pjb-unicode-map-character-ranges (string ranges)
   (map 'string (lambda (ch)
                  (let ((range (find-if (lambda (range)  (<= (first range) ch (second range)))
diff --git a/pjb-work.el b/pjb-work.el
index cf029a8..cfa791b 100644
--- a/pjb-work.el
+++ b/pjb-work.el
@@ -51,7 +51,7 @@
   "Inserts the date and time."
   (interactive)
   (beginning-of-line)
-  (insert (format-time-string " %Y-%m-%d ( \"%H:%M:%S\" \"\" ) ; \n\n   - "))
+  (insert (format-time-string "%Y-%m-%d ( \"%H:%M:%S\" \"\" ) ; \n\n   - "))
   (end-of-line))


@@ -73,9 +73,6 @@



-
-
-
 (defvar *pjb-work-duration-regexp*
   "( \"\\(..:..:..\\)\" \"\\(..:..:..\\)\" )\\(.*\\)\n")

@@ -131,21 +128,18 @@ found backward from the point."
     (setq amount (* total hourly-rate))
     (setq totalstring
           (concat
-           (format " Total %30s %10s = %5.2f j   (%6.2f h)\n" "" (d-dms total) (/ total 8.0) total)
-           (format " Facturation %34s %8.2f EUR HT\n" "" amount)
-           (format " Hourly Rate %34s    %5.2f EUR HT/hour\n" "" hourly-rate)))
+           (format "Total %30s %10s = %5.2f j   (%6.2f h)\n" "" (d-dms total) (/ total 8.0) total)
+           (format "Facturation %34s %8.2f EUR HT\n" "" amount)
+           (format "Hourly Rate %34s    %5.2f EUR HT/hour\n" "" hourly-rate)))
     ;; insert the total string.
     (goto-char (point-min))
-    (if (search-forward-regexp
-         " Total.*\n Facturation.*\n Hourly Rate.*\n" nil t)
+    (if (search-forward-regexp "Total.*\nFacturation.*\nHourly Rate.*\n" nil t)
         (replace-match totalstring)
         (if (search-forward-regexp (format " %s\n" (make-string 72 ?=)) nil t)
             (goto-char (match-end 0))
             (goto-char (point-max)))
         (insert totalstring))))

-
-
 (defun intervention-file-path (firm project date)
   "
 RETURN:  The file name formated from the firm, project and date.
@@ -240,10 +234,10 @@ RETURN: A list of the names of projects initiated for the FIRM.
         (insert header)
         (insert "\n\n\n\n\n")
         (insert footer)
-        (insert "\n Total:\n Facturation:\n Hourly Rate:\n\n\n"))
+        (insert "\nTotal:\nFacturation:\nHourly Rate:\n\n\n"))
       (cond
         ((progn (goto-char (point-min))
-                (search-forward-regexp " Total.*\n Facturation.*" nil t))
+                (search-forward-regexp "Total.*\nFacturation.*" nil t))
          (beginning-of-line)
          (if (search-backward "===="
                               (save-excursion (forward-line -5) (point)) t)
ViewGit