[elpa] externals/dicom 2c84fab4cd 06/10: Reorder code

[ELPA Syncer]

branch: externals/dicom
commit 2c84fab4cd4dc489c4aec408673c107d905981b2
Author: Daniel Mendler <mail@daniel-mendler.de>
Commit: Daniel Mendler <mail@daniel-mendler.de>

    Reorder code
---
 dicom.el | 487 ++++++++++++++++++++++++++++++++-------------------------------
 1 file changed, 250 insertions(+), 237 deletions(-)

diff --git a/dicom.el b/dicom.el
index 91e9bb65cd..21d24ec62f 100644
--- a/dicom.el
+++ b/dicom.el
@@ -53,6 +53,8 @@
 (require 'cus-edit)
 (require 'subr-x)
 
+;;;; Customization
+
 (defgroup dicom nil
   "DICOM viewer - Digital Imaging and Communications in Medicine."
   :link '(info-link :tag "Info Manual" "(dicom)")
@@ -95,6 +97,8 @@ progress:${percent-pos}%%' %s) & disown"
   "Video player command line."
   :type 'string)
 
+;;;; Faces
+
 (defgroup dicom-faces nil
   "Faces used by DICOM."
   :group 'dicom
@@ -108,11 +112,46 @@ progress:${percent-pos}%%' %s) & disown"
   '((t :inherit (header-line outline-2) :extend t))
   "Item face.")
 
+;;;; Keymaps
+
+(defvar-keymap dicom-image-map
+  :doc "Keymap used for images at point."
+  "RET" #'dicom-open-at-point
+  "<mouse-1>" #'dicom-open-at-point)
+
+(defvar-keymap dicom-mode-map
+  :doc "Keymap used by `dicom-mode'."
+  :parent special-mode-map
+  "p" #'dicom-play
+  "+" #'dicom-larger
+  "-" #'dicom-smaller
+  "r" #'dicom-rotate
+  "TAB" #'outline-cycle
+  "<backtab>" #'outline-cycle-buffer)
+
+(easy-menu-define dicom-mode-menu dicom-mode-map
+  "Menu for `dicom-mode'."
+  '("DICOM"
+    ["Revert" revert-buffer]
+    ["Larger" dicom-larger]
+    ["Smaller" dicom-smaller]
+    ["Rotate" dicom-rotate]
+    ["Play" dicom-play]
+    "--"
+    ["Manual" (info "(dicom)")]
+    ["Customize" (customize-group 'dicom)]))
+
+(define-derived-mode dicom-mode special-mode "DICOM"
+  "DICOM mode."
+  :interactive nil :abbrev-table nil :syntax-table nil)
+
+;;;; Internal variables
+
 (defvar-local dicom--data nil
-  "DICOM data of the current buffer.")
+  "Metadata of the current buffer.")
 
 (defvar-local dicom--file nil
-  "DICOM file associated with the current buffer.")
+  "File associated with the current buffer.")
 
 (defvar-local dicom--queue nil
   "Conversion process queue in current buffer.")
@@ -143,36 +182,13 @@ progress:${percent-pos}%%' %s) & disown"
 </svg>"))
   "Large placeholder image.")
 
-(defvar-keymap dicom-image-map
-  :doc "Keymap used for images at point."
-  "RET" #'dicom-open-at-point
-  "<mouse-1>" #'dicom-open-at-point)
-
-(defvar-keymap dicom-mode-map
-  :doc "Keymap used by `dicom-mode'."
-  :parent special-mode-map
-  "p" #'dicom-play
-  "+" #'dicom-larger
-  "-" #'dicom-smaller
-  "r" #'dicom-rotate
-  "TAB" #'outline-cycle
-  "<backtab>" #'outline-cycle-buffer)
-
-(easy-menu-define dicom-mode-menu dicom-mode-map
-  "Menu for `dicom-mode'."
-  '("DICOM"
-    ["Revert" revert-buffer]
-    ["Larger" dicom-larger]
-    ["Smaller" dicom-smaller]
-    ["Rotate" dicom-rotate]
-    ["Play" dicom-play]
-    "--"
-    ["Manual" (info "(dicom)")]
-    ["Customize" (customize-group 'dicom)]))
+;;;; Internal functions
 
-(define-derived-mode dicom-mode special-mode "DICOM"
-  "DICOM mode."
-  :interactive nil :abbrev-table nil :syntax-table nil)
+(defun dicom--bookmark-record ()
+  "Create DICOM bookmark."
+  `(,(string-join (dicom--file-name))
+    (filename . ,dicom--file)
+    (handler . ,#'dicom-bookmark-jump)))
 
 (defun dicom--stop (proc)
   "Gracefully stop PROC."
@@ -186,6 +202,29 @@ progress:${percent-pos}%%' %s) & disown"
     (put-text-property pos (1+ pos) 'display
                        `(image :margin 8 :type png :file ,file))))
 
+(defun dicom--dir-p (&optional file)
+  "Non-nil if FILE is a DICOMDIR."
+  (setq file (or file dicom--file))
+  (and file (string-search "DICOMDIR" file)))
+
+(defun dicom--file-name (&optional file)
+  "Shortened FILE name."
+  (setq file (or file dicom--file))
+  (if (dicom--dir-p file)
+      (list "dicom dir: "
+            (file-name-base
+             (directory-file-name
+              (file-name-parent-directory file))))
+    (list "dicom image: "
+          (if-let ((dir (locate-dominating-file file "DICOMDIR")))
+              (file-name-sans-extension
+               (file-relative-name file (file-name-parent-directory dir)))
+            (file-name-base file)))))
+
+(defun dicom--buffer-name (file)
+  "Buffer name for FILE."
+  (format "*%s*" (string-join (dicom--file-name file))))
+
 (defun dicom--cache-name (file &optional ext)
   "Cache file name given FILE name and EXT."
   (make-directory dicom-cache-dir t)
@@ -193,93 +232,6 @@ progress:${percent-pos}%%' %s) & disown"
         file (file-name-concat dicom-cache-dir (md5 file)))
   (cons (concat file "." ext) (concat file ".tmp." ext)))
 
-(defun dicom--insert (item)
-  "Insert ITEM in buffer."
-  (let ((type (alist-get 'DirectoryRecordType item)))
-    (insert "\n" (format
-                  (propertize " %s %s\n" 'face 'dicom-item)
-                  (or type "Item")
-                  (or (and type (or (alist-get 'StudyID item)
-                                    (alist-get 'SeriesDescription item)
-                                    (alist-get 'PatientName item)))
-                      ""))))
-  (pcase-dolist (`(,k . ,v) item)
-    (unless (memq k dicom-hidden-fields)
-      (let* ((k (symbol-name k))
-             (s k))
-        (when (> (length s) dicom-field-width)
-          (setq s (truncate-string-to-width k dicom-field-width 0 nil "…"))
-          (put-text-property 0 (length s) 'help-echo k s))
-        (setq s (string-pad s dicom-field-width))
-        (insert (format "    %s  %s\n" s v))))))
-
-(defun dicom--insert-all ()
-  "Insert all items into buffer."
-  (dolist (item dicom--data)
-    (let ((pos (point)))
-      (dicom--insert item)
-      (when (equal (alist-get 'DirectoryRecordType item) "IMAGE")
-        (pcase-let* ((src (expand-file-name
-                           (string-replace "\\" "/" (alist-get 
'ReferencedFileID item))))
-                     (`(,dst . ,tmp) (dicom--cache-name src))
-                     (tooltip (buffer-substring-no-properties (1+ pos) 
(point))))
-          (delete-region pos (point))
-          (insert (propertize
-                   " " 'display `(image ,@dicom--thumb-placeholder)
-                   'pointer 'hand
-                   'keymap dicom-image-map
-                   'dicom--file src
-                   'help-echo tooltip))
-          (if (file-exists-p dst)
-              (dicom--put-image pos dst)
-            (dicom--enqueue
-             (lambda (success)
-               (if success
-                   (progn
-                     (rename-file tmp dst)
-                     (dicom--put-image pos dst))
-                 (delete-file tmp)))
-             "dcmj2pnm" "--write-png" "--scale-y-size" "200" src tmp)))))))
-
-(defun dicom--button (label action)
-  "Insert button with LABEL and ACTION."
-  (insert (propertize
-           (format
-            "  %s %s  "
-            (key-description (where-is-internal action nil t t)) label)
-           'keymap (define-keymap
-                     "RET" action
-                     "<down-mouse-1>" #'ignore
-                     "<mouse-1>" (lambda (_event)
-                                   (interactive "@e")
-                                   (call-interactively action)))
-           'face 'custom-button 'mouse-face 'custom-button-mouse)
-          " "))
-
-(defun dicom--insert-large ()
-  "Insert large image."
-  (pcase-let ((`(,dst . ,tmp) (dicom--cache-name (concat "large" 
dicom--file))))
-    (insert "\n")
-    (dicom--button "Revert" #'revert-buffer)
-    (dicom--button "Larger" #'dicom-larger)
-    (dicom--button "Smaller" #'dicom-smaller)
-    (dicom--button "Rotate" #'dicom-rotate)
-    (when-let ((frames (alist-get 'NumberOfFrames (car dicom--data))))
-      (dicom--button (format "Play (%s frames)" frames) #'dicom-play))
-    (insert "\n\n")
-    (let ((pos (point)))
-      (insert dicom--large-placeholder "\n")
-      (if (file-exists-p dst)
-        (dicom--put-image pos dst)
-      (dicom--enqueue
-       (lambda (success)
-         (if success
-             (progn
-               (rename-file tmp dst)
-               (dicom--put-image pos dst))
-           (delete-file tmp)))
-       "dcmj2pnm" "--write-png" dicom--file tmp)))))
-
 (defun dicom--read (file)
   "Read DICOM FILE and return list of items."
   (let ((dom (with-temp-buffer
@@ -310,20 +262,6 @@ progress:${percent-pos}%%' %s) & disown"
           (push (sort alist (lambda (x y) (string< (car x) (car y)))) items))))
     (nreverse items)))
 
-;;;###autoload
-(defun dicom-open-at-point ()
-  "Open DICOM at point."
-  (interactive)
-  (if-let ((file
-            (if (mouse-event-p last-input-event)
-                (or (mouse-posn-property (event-start last-input-event)
-                                         'dicom--file)
-                    (thing-at-mouse last-input-event 'filename))
-              (or (get-text-property (point) 'dicom--file)
-                  (thing-at-point 'filename)))))
-      (dicom-open file (and (not last-prefix-arg) "*dicom image*"))
-    (user-error "DICOM: No DICOM file at point")))
-
 (defun dicom--image-buffer ()
   "Return image buffer or throw an error."
   (if (dicom--dir-p)
@@ -331,14 +269,6 @@ progress:${percent-pos}%%' %s) & disown"
           (user-error "DICOM: No open image"))
     (current-buffer)))
 
-(defun dicom-rotate ()
-  "Rotate image by 90°."
-  (interactive nil dicom-mode)
-  (dicom--modify-image
-   (lambda (image)
-     (setf (image-property image :rotation)
-           (float (mod (+ (or (image-property image :rotation) 0) 90) 360))))))
-
 (defun dicom--modify-image (fun)
   "Modify image properties by FUN."
   (with-current-buffer (dicom--image-buffer)
@@ -348,38 +278,6 @@ progress:${percent-pos}%%' %s) & disown"
        (funcall fun image)
        (put-text-property pos (1+ pos) 'display `(image ,@(cdr image)))))))
 
-(defun dicom-larger (n)
-  "Image larger by N."
-  (interactive "p" dicom-mode)
-  (dicom--modify-image
-   (lambda (image)
-     (setf (image-property image :scale)
-           (max 0.1 (min 10 (+ (* n 0.1) (or (image-property image :scale) 
1.0))))))))
-
-(defun dicom-smaller (n)
-  "Image smaller by N."
-  (interactive "p" dicom-mode)
-  (dicom-larger (- n)))
-
-(defun dicom-open (file &optional reuse)
-  "Open DICOM dir or image FILE.
-REUSE can be a buffer name to reuse."
-  (interactive "fDICOM: ")
-  (let* ((file (expand-file-name (if (directory-name-p file)
-                                     (file-name-concat file "DICOMDIR")
-                                   file)))
-         (default-directory (file-name-directory file))
-         (buf (or reuse (dicom--buffer-name file))))
-    (unless (file-regular-p file)
-      (user-error "DICOM: File %s not found" file))
-    (unless (when-let ((buf (get-buffer buf)))
-              (equal (buffer-local-value 'dicom--file buf) file))
-      (with-current-buffer (get-buffer-create buf)
-        (dicom--setup file)))
-    (if reuse
-        (display-buffer buf '(nil (inhibit-same-window . t)))
-      (pop-to-buffer buf))))
-
 (defun dicom--run (cb &rest args)
   "Run process with ARGS asynchronously and call CB when the process finished."
   (let ((default-directory "/"))
@@ -413,39 +311,92 @@ REUSE can be a buffer name to reuse."
     (setq dicom--queue (nbutlast dicom--queue))
     (apply #'dicom--run job)))
 
-(defun dicom-play ()
-  "Play DICOM multi frame image."
-  (interactive nil dicom-mode)
-  (with-current-buffer (dicom--image-buffer)
-   (pcase-let ((`(,dst . ,tmp) (dicom--cache-name dicom--file "mp4")))
-     (cond
-      ((file-exists-p dst)
-       (message "Playing %s…" dicom--file)
-       (call-process-shell-command
-        (format dicom-play-command (shell-quote-argument dst))
-        nil 0))
-      (dicom--proc
-       (message "Conversion in progress…"))
-      (t
-       (unless (alist-get 'NumberOfFrames (car dicom--data))
-         (user-error "DICOM: No multi frame image"))
-       (let ((rate (or (alist-get 'RecommendedDisplayFrameRate (car 
dicom--data))
-                       (alist-get 'CineRate (car dicom--data))
-                       25))
-             dicom-timeout)
-         (message "Converting %s…" dicom--file)
-         (dicom--enqueue
-          (lambda (success)
-            (if success
-                (progn
-                  (rename-file tmp dst)
-                  (dicom-play))
-              (delete-file tmp)))
-          "sh" "-c"
-          (format "dcmj2pnm --all-frames --write-bmp %s | ffmpeg -framerate %s 
-i - %s"
-                  (shell-quote-argument dicom--file)
-                  rate
-                  (shell-quote-argument tmp)))))))))
+(defun dicom--button (label action)
+  "Insert button with LABEL and ACTION."
+  (insert (propertize
+           (format
+            "  %s %s  "
+            (key-description (where-is-internal action nil t t)) label)
+           'keymap (define-keymap
+                     "RET" action
+                     "<down-mouse-1>" #'ignore
+                     "<mouse-1>" (lambda (_event)
+                                   (interactive "@e")
+                                   (call-interactively action)))
+           'face 'custom-button 'mouse-face 'custom-button-mouse)
+          " "))
+
+(defun dicom--insert (item)
+  "Insert ITEM in buffer."
+  (let ((type (alist-get 'DirectoryRecordType item)))
+    (insert "\n" (format
+                  (propertize " %s %s\n" 'face 'dicom-item)
+                  (or type "Item")
+                  (or (and type (or (alist-get 'StudyID item)
+                                    (alist-get 'SeriesDescription item)
+                                    (alist-get 'PatientName item)))
+                      ""))))
+  (pcase-dolist (`(,k . ,v) item)
+    (unless (memq k dicom-hidden-fields)
+      (let* ((k (symbol-name k))
+             (s k))
+        (when (> (length s) dicom-field-width)
+          (setq s (truncate-string-to-width k dicom-field-width 0 nil "…"))
+          (put-text-property 0 (length s) 'help-echo k s))
+        (setq s (string-pad s dicom-field-width))
+        (insert (format "    %s  %s\n" s v))))))
+
+(defun dicom--insert-all ()
+  "Insert all items into buffer."
+  (dolist (item dicom--data)
+    (let ((pos (point)))
+      (dicom--insert item)
+      (when (equal (alist-get 'DirectoryRecordType item) "IMAGE")
+        (pcase-let* ((src (expand-file-name
+                           (string-replace "\\" "/" (alist-get 
'ReferencedFileID item))))
+                     (`(,dst . ,tmp) (dicom--cache-name src))
+                     (tooltip (buffer-substring-no-properties (1+ pos) 
(point))))
+          (delete-region pos (point))
+          (insert (propertize
+                   " " 'display `(image ,@dicom--thumb-placeholder)
+                   'pointer 'hand
+                   'keymap dicom-image-map
+                   'dicom--file src
+                   'help-echo tooltip))
+          (if (file-exists-p dst)
+              (dicom--put-image pos dst)
+            (dicom--enqueue
+             (lambda (success)
+               (if success
+                   (progn
+                     (rename-file tmp dst)
+                     (dicom--put-image pos dst))
+                 (delete-file tmp)))
+             "dcmj2pnm" "--write-png" "--scale-y-size" "200" src tmp)))))))
+
+(defun dicom--insert-large ()
+  "Insert large image."
+  (pcase-let ((`(,dst . ,tmp) (dicom--cache-name (concat "large" 
dicom--file))))
+    (insert "\n")
+    (dicom--button "Revert" #'revert-buffer)
+    (dicom--button "Larger" #'dicom-larger)
+    (dicom--button "Smaller" #'dicom-smaller)
+    (dicom--button "Rotate" #'dicom-rotate)
+    (when-let ((frames (alist-get 'NumberOfFrames (car dicom--data))))
+      (dicom--button (format "Play (%s frames)" frames) #'dicom-play))
+    (insert "\n\n")
+    (let ((pos (point)))
+      (insert dicom--large-placeholder "\n")
+      (if (file-exists-p dst)
+        (dicom--put-image pos dst)
+      (dicom--enqueue
+       (lambda (success)
+         (if success
+             (progn
+               (rename-file tmp dst)
+               (dicom--put-image pos dst))
+           (delete-file tmp)))
+       "dcmj2pnm" "--write-png" dicom--file tmp)))))
 
 (defun dicom--setup-check ()
   "Check requirements."
@@ -506,37 +457,96 @@ REUSE can be a buffer name to reuse."
      (kill-buffer)
      (signal (car err) (cdr err)))))
 
-(defun dicom--dir-p (&optional file)
-  "Non-nil if FILE is a DICOMDIR."
-  (setq file (or file dicom--file))
-  (and file (string-search "DICOMDIR" file)))
+;;;; Public commands
 
-(defun dicom--file-name (&optional file)
-  "Shortened FILE name."
-  (setq file (or file dicom--file))
-  (if (dicom--dir-p file)
-      (list "dicom dir: "
-            (file-name-base
-             (directory-file-name
-              (file-name-parent-directory file))))
-    (list "dicom image: "
-          (if-let ((dir (locate-dominating-file file "DICOMDIR")))
-              (file-name-sans-extension
-               (file-relative-name file (file-name-parent-directory dir)))
-            (file-name-base file)))))
+(defun dicom-rotate ()
+  "Rotate image by 90°."
+  (interactive nil dicom-mode)
+  (dicom--modify-image
+   (lambda (image)
+     (setf (image-property image :rotation)
+           (float (mod (+ (or (image-property image :rotation) 0) 90) 360))))))
 
-(defun dicom--buffer-name (file)
-  "Buffer name for FILE."
-  (format "*%s*" (string-join (dicom--file-name file))))
+(defun dicom-larger (n)
+  "Image larger by N."
+  (interactive "p" dicom-mode)
+  (dicom--modify-image
+   (lambda (image)
+     (setf (image-property image :scale)
+           (max 0.1 (min 10 (+ (* n 0.1) (or (image-property image :scale) 
1.0))))))))
+
+(defun dicom-smaller (n)
+  "Image smaller by N."
+  (interactive "p" dicom-mode)
+  (dicom-larger (- n)))
+
+(defun dicom-play ()
+  "Play DICOM multi frame image."
+  (interactive nil dicom-mode)
+  (with-current-buffer (dicom--image-buffer)
+   (pcase-let ((`(,dst . ,tmp) (dicom--cache-name dicom--file "mp4")))
+     (cond
+      ((file-exists-p dst)
+       (message "Playing %s…" dicom--file)
+       (call-process-shell-command
+        (format dicom-play-command (shell-quote-argument dst))
+        nil 0))
+      (dicom--proc
+       (message "Conversion in progress…"))
+      (t
+       (unless (alist-get 'NumberOfFrames (car dicom--data))
+         (user-error "DICOM: No multi frame image"))
+       (let ((rate (or (alist-get 'RecommendedDisplayFrameRate (car 
dicom--data))
+                       (alist-get 'CineRate (car dicom--data))
+                       25))
+             dicom-timeout)
+         (message "Converting %s…" dicom--file)
+         (dicom--enqueue
+          (lambda (success)
+            (if success
+                (progn
+                  (rename-file tmp dst)
+                  (dicom-play))
+              (delete-file tmp)))
+          "sh" "-c"
+          (format "dcmj2pnm --all-frames --write-bmp %s | ffmpeg -framerate %s 
-i - %s"
+                  (shell-quote-argument dicom--file)
+                  rate
+                  (shell-quote-argument tmp)))))))))
 
 ;;;###autoload
-(defun dicom-auto-mode ()
-  "Enable `dicom-mode' in current buffer."
-  (let ((file (expand-file-name buffer-file-name)))
-    (setq-local buffer-file-name nil
-                buffer-file-truename nil)
-    (rename-buffer (dicom--buffer-name file) t)
-    (dicom--setup file)))
+(defun dicom-open-at-point ()
+  "Open DICOM at point."
+  (interactive)
+  (if-let ((file
+            (if (mouse-event-p last-input-event)
+                (or (mouse-posn-property (event-start last-input-event)
+                                         'dicom--file)
+                    (thing-at-mouse last-input-event 'filename))
+              (or (get-text-property (point) 'dicom--file)
+                  (thing-at-point 'filename)))))
+      (dicom-open file (and (not last-prefix-arg) "*dicom image*"))
+    (user-error "DICOM: No DICOM file at point")))
+
+;;;###autoload
+(defun dicom-open (file &optional reuse)
+  "Open DICOM dir or image FILE.
+REUSE can be a buffer name to reuse."
+  (interactive "fDICOM: ")
+  (let* ((file (expand-file-name (if (directory-name-p file)
+                                     (file-name-concat file "DICOMDIR")
+                                   file)))
+         (default-directory (file-name-directory file))
+         (buf (or reuse (dicom--buffer-name file))))
+    (unless (file-regular-p file)
+      (user-error "DICOM: File %s not found" file))
+    (unless (when-let ((buf (get-buffer buf)))
+              (equal (buffer-local-value 'dicom--file buf) file))
+      (with-current-buffer (get-buffer-create buf)
+        (dicom--setup file)))
+    (if reuse
+        (display-buffer buf '(nil (inhibit-same-window . t)))
+      (pop-to-buffer buf))))
 
 ;;;###autoload
 (defun dicom-bookmark-jump (bm)
@@ -545,11 +555,14 @@ REUSE can be a buffer name to reuse."
   (dicom-open (bookmark-get-filename bm)))
 (put 'dicom-bookmark-jump 'bookmark-handler-type "DICOM")
 
-(defun dicom--bookmark-record ()
-  "Create DICOM bookmark."
-  `(,(string-join (dicom--file-name))
-    (filename . ,dicom--file)
-    (handler . ,#'dicom-bookmark-jump)))
+;;;###autoload
+(defun dicom-auto-mode ()
+  "Enable `dicom-mode' in current buffer."
+  (let ((file (expand-file-name buffer-file-name)))
+    (setq-local buffer-file-name nil
+                buffer-file-truename nil)
+    (rename-buffer (dicom--buffer-name file) t)
+    (dicom--setup file)))
 
 ;;;###autoload
 (progn