;;; kalenderbilder.el --- http://herbaer.de/xmlns/20130131/kleider
;;; file KLEIDER/web/src/kalender/kalenderbilder.el

;; Copyright 2017 Herbert Schiemann

;; Author: Herbert Schiemann <h.schiemann@herbaer.de>
;; Created: 2017-01-01
;; Modified: 2020-11-29
;; Keywords: kalenderbilder

; 2020-11-29 gui-get-selection statt x-get-selection                                    ;

;;; Code:

; Der Cursor muss sich in einem (relativen) URL der folgenden Form befinden:
; s2011w44/story.xml.de#s20_1h4syi9w_2
(defun hbkalenderbilder-url-to-m ()
  "m-Element aus URL"
  (interactive)
  (let
      (
       (rtn nil)
       (pnt (point))
       story
       img
       frgm
       m
       mm
       pt
       (re
        (concat
         "\\(http://\\)?[a-z0-9_./]*?"
         "s\\([a-z0-9_]+\\)/s[a-z.]*\\(#s[0-9]*_\\([a-z0-9]+\\)[^[:space:]]*\\)"
         ))
       )
    (re-search-backward "[^a-z0-9#_.:/]")
    (forward-char)
    (when (looking-at re)
      (setq story (match-string 2))
      (setq frgm  (match-string 3))
      (setq img   (match-string 4))
      (goto-char (point-min))
      (search-forward "</kalenderbilder>")
      (setq pt (- (point) 17))
      (if (re-search-backward "<m\\s-+mm\\s-*=\\s-*\"0*\\([0-9]+\\)\"\\s-*>" (point-min) t)
          (progn
            (setq m (string-to-number (match-string 1)))
            (setq mm (if (< m 12) (format "%02d" (1+ m)) "x"))
            )
        (setq mm "01")
        )
      (goto-char pt)
      (insert "  <m mm = \"" mm "\"><s>" story frgm "</s><i>" img "</i></m>\n")
      (setq rtn t)
      )
    (goto-char pnt)
    rtn
    )
  ) ; hbkalenderbilder-url-to-m

; Kalender aus aufeinander folgenden URL-Zeilen
(defun hbkalenderbilder-make-calendar ()
  "Kalender aus aufeinander folgenden URL-Zeilen"
  (interactive)
  (let
      (
       (c 12)
       )
    (while (> c 0)
      (if (hbkalenderbilder-url-to-m)
          (progn
            (forward-line)
            (setq c (1- c))
            )
        (setq c 0)
        )
      )
    )
  ) ; hbkalenderbilder-make-calendar

(defun hbkalenderbilder-renum-m ()
  "m-Elemente neu numerieren"
  (interactive)
  (let
      (
       (pnt (point))
       ybeg
       yend
       m
       mm
       )
    (goto-char (point-min))
    (search-forward "<kalenderbilder")
    (setq ybeg (point))
    (search-forward "</kalenderbilder>")
    (setq yend (point))
    (goto-char ybeg)
    (setq m 0)
    (while
        (re-search-forward "<m\\s-*mm\\s-*=\\s-*\"\\([a-z0-9]*\\)\"" yend t)
      (setq m (1+ m))
      (setq mm (format "%02d" m))
      (goto-char (match-beginning 1))
      (delete-region (match-beginning 1) (match-end 1))
      (insert mm)
      )
    (goto-char pnt)
    )
  ) ; hbkalenderbilder-renum-m

(defun hbkalenderbilder-insert-xselection-url ()
  "URL aus X-Selection vor der nächsten Leerzeile oder Kommentarende einfügen"
  (interactive)
  (let
      (
       (url (gui-get-selection))
       )
    (when
        (and
         (string-match-p "^\\(http://\\)?[a-z0-9_./]*?s[a-z0-9_]+/s[a-z.]*#s[0-9]*_[a-z0-9_]+$" url)
         (re-search-forward "\n\\s-*?\n\\|-->" (point-max) t)
         )
      (goto-char (match-beginning 0))
      (or (char-equal (char-after) ?-) (forward-char))
      (insert url "\n")
      (beginning-of-line)
      )
    )
  ) ; hbkalenderbilder-insert-xselection-url

;; Liste sortieren
(defun hb-sort-list (lst comp)
  "Sortiert die Liste lst
comp bestimmt die Sortier-Reihenfolge.
comp wird mit zwei Werten der Liste lst als Parameter aufgerufen.
Das Ergebnis ist t, wenn der erste Wert vor dem zweiten Wert
einsortiert wird.
"
  (if (and lst (cdr lst))
      (let (
            (a lst)
            (b (cdr lst))
            (pre lst)
            )
        (while lst
          (setcdr pre (cdr lst))
          (setq pre lst)
          (setq lst (cdr lst))
          )
        (setq pre (cons nil (hb-sort-list a comp)))
        (setq b (hb-sort-list b comp))
        (setq lst pre)
        (while (and (cdr lst) b)
          (when (funcall comp (car b) (car (cdr lst)))
               (setq a (cdr lst))
               (setcdr lst b)
               (setq b a)
               )
          (setq lst (cdr lst))
          )
        (if b (setcdr lst b))
        (cdr pre)
        )
    lst
    )
  ) ; hb-sort-list

;; Zeilen sortieren
(defun hb-sort-lines ()
  "Sortiert die Zeilen bis zur nächsten leeren Zeile"
  (interactive)
  (let (
        (pnt    (point))
        (ls     (cons nil nil))
        lend
        ln
        )
    (setq lend ls)
    (beginning-of-line)
    (setq ln (buffer-substring (point) (line-end-position)))
    (while (string-match "[^[:space:]]" ln)
      (setcdr lend (cons ln nil))
      (setq lend (cdr lend))
      (delete-region (point) (1+ (line-end-position)))
      (setq ln (buffer-substring (point) (line-end-position)))
      )
    (setq ls (hb-sort-list (cdr ls) 'string< ))
    (while ls
      (insert (car ls) "\n")
      (setq ls (cdr ls))
      )
    (goto-char pnt)
    )
  ) ; hb-sort-lines

(defun hb-rm-same-lines-in-block ()
  "Entfernt Zeilen, die im Block mehrfach vorkommen"
  (interactive)
  (let (
        (pnt (point))
        pnt1
        ln1
        ln2
        fl
        )
    (beginning-of-line)
    (setq ln1 (buffer-substring (point) (line-end-position)))
    (while (string-match "[^[:space:]]" ln1)
      (setq pnt1 (point))
      (if (= 0 (forward-line))
          (setq ln2 (buffer-substring (point) (line-end-position)))
        (setq ln2 "")
        )
      (while (string-match "[^[:space:]]" ln2)
        (setq fl 0)
        (if (string= ln1 ln2)
            (delete-region (point) (1+ (line-end-position)))
          (setq fl (forward-line))
          )
        (if (= fl 0)
            (setq ln2 (buffer-substring (point) (line-end-position)))
          (setq ln2 "")
          )
        )
      (goto-char pnt1)
      (if (= 0 (forward-line))
          (setq ln1 (buffer-substring (point) (line-end-position)))
        (setq ln1 "")
        )
      )
    (goto-char pnt)
    )
  )
 ; hb-rm-same-lines-in-block

(defun hbkalenderbilder-sort-m ()
  "Sortiert die m-Elemente nach dem Attribut mm"
  (interactive)
  (let (
        (ls     (cons nil nil))
        lend
        m
        )
    (setq lend ls)
    (goto-char (point-min))
    (search-forward "<kalenderbilder" (point-max) t)
    (while (re-search-forward "\\s-*\\(<m.+?</m>\\)\\s-*" (point-max) t)
      (setq m (match-string 1))
      (goto-char (match-beginning 0))
      (delete-region (match-beginning 0) (match-end 0))
      (setcdr lend
              (cons
               (cons 
                m
                (if (string-match "<m\\s-+mm\\s-*=\\s-*\"\\([0-9]+\\)\"" m)
                    (string-to-number (match-string 1 m))
                  99
                  )
                )
               nil
               )
              )
      (setq lend (cdr lend))
      )
    (setq ls
          (hb-sort-list (cdr ls)
                        (lambda (a b) (< (cdr a) (cdr b)))
                        )
          )
    (goto-char (point-min))
    (search-forward "</kalenderbilder>" (point-max) t)
    (goto-char (match-beginning 0))
    (insert "\n")
    (while ls
      (insert "  " (car (car ls)) "\n")
      (setq ls (cdr ls))
      )
    )
  ) ; hbkalenderbilder-sort-m

(defun hbkalenderbilder-random-line-to-top ()
  "Vertauscht die aktuelle Zeile mit einer pseudo-zufällig gewählten Folgezeile"
  (interactive)
  (let
      (
       (lb (line-beginning-position))
       le
       (nl 0)
       ln1
       ln2
       )
    (beginning-of-line)
    (while (not (looking-at "\\s*?\n"))
      (forward-line)
      (setq nl (1+ nl))
      )
    (goto-char lb)
    (and (> nl 0) (setq nl (random nl)))
    (if (= nl 0)
        (forward-line)
      (setq le (1+ (line-end-position)))
      (setq ln1 (buffer-substring (point) le))
      (delete-region lb le)
      (setq nl (1- nl))
      (while (> nl 0)
        (forward-line)
        (setq nl (1- nl))
        )
      (setq le (1+ (line-end-position)))
      (setq ln2 (buffer-substring (point) le))
      (delete-region (point) le)
      (insert ln1)
      (goto-char lb)
      (insert ln2)
      )
    )
  ) ; hbkalenderbilder-random-line-to-top

(defun hbkalenderbilder-shuffle-lines ()
  "Mischt Zeilen pseudo-zufällig"
  (interactive)
  (random t)
  (beginning-of-line)
  (let (
        (pnt (point))
      )
    (while (not (looking-at "\\s*?\n"))
      (hbkalenderbilder-random-line-to-top)
      )
    (goto-char pnt)
    )
  ) ; hbkalenderbilder-shuffle-lines

(let ((map (make-sparse-keymap)))
  (define-key map "\C-ce"    'hb-rm-same-lines-in-block)
  (define-key map "\C-ci"    'hbkalenderbilder-insert-xselection-url)
  (define-key map "\C-ck"    'hbkalenderbilder-make-calendar)
  (define-key map "\C-cl"    'hb-sort-lines)
  (define-key map "\C-cm"    'hbkalenderbilder-sort-m)
  (define-key map "\C-cr"    'hbkalenderbilder-renum-m)
  (define-key map "\C-cs"    'hbkalenderbilder-url-to-m)
  (define-key map "\C-ct"    'hbkalenderbilder-random-line-to-top)
  (define-key map "\C-cx"    'hbkalenderbilder-shuffle-lines)
  (set-keymap-parent map nxml-mode-map)
  (use-local-map map)
  )

;;; kalenderbilder.el ends here
;;; end of file KLEIDER/web/src/kalender/kalenderbilder.el