emacs-elpa-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[elpa] externals/hyperbole d183335099 1/5: Made hactypes:link-to-file-in


From: ELPA Syncer
Subject: [elpa] externals/hyperbole d183335099 1/5: Made hactypes:link-to-file-interactively a standalone function
Date: Sat, 12 Feb 2022 17:57:32 -0500 (EST)

branch: externals/hyperbole
commit d183335099d4883111f7b5f43039f23f121e6ada
Author: Kathy <rsw@gnu.org>
Commit: Kathy <rsw@gnu.org>

    Made hactypes:link-to-file-interactively a standalone function
    
    This simplifies link-to-file interactive call and facilitates
    easier debugging
---
 hactypes.el | 133 +++++++++++++++++++++++++++++++-----------------------------
 1 file changed, 68 insertions(+), 65 deletions(-)

diff --git a/hactypes.el b/hactypes.el
index ca20d91bb5..0d716e77d7 100644
--- a/hactypes.el
+++ b/hactypes.el
@@ -3,7 +3,7 @@
 ;; Author:       Bob Weiner
 ;;
 ;; Orig-Date:    23-Sep-91 at 20:34:36
-;; Last-Mod:      5-Feb-22 at 11:39:05 by Bob Weiner
+;; Last-Mod:     12-Feb-22 at 10:38:30 by Bob Weiner
 ;;
 ;; Copyright (C) 1991-2022  Free Software Foundation, Inc.
 ;; See the "HY-COPY" file for license information.
@@ -326,74 +326,77 @@ Interactively, KEY-FILE defaults to the current buffer's 
file name."
             (hpath:display-buffer (help-buffer))
             (describe-symbol symbol)))))
 
+(defun  hactypes:link-to-file-interactively ()
+  "Get a path to link to and return it as a one item list."
+  (let ((prev-reading-p hargs:reading-type)
+       (existing-buf t)
+       path-buf)
+    (unwind-protect
+       (let* ((default-directory (or (hattr:get 'hbut:current 'dir)
+                                     (file-name-directory
+                                      (or (hattr:get 'hbut:current 'loc) ""))
+                                     default-directory))
+              (file-path (or (car hargs:defaults) default-directory))
+              (file-point (cadr hargs:defaults))
+              (hargs:reading-type 'file)
+              ;; If reading interactive inputs from a key series
+              ;; (puts key events into the unread queue), then don't
+              ;; insert default-directory into the minibuffer
+              ;; prompt, allowing time to remove any extra pathname
+              ;; quotes added in the key series.
+              (insert-default-directory (not unread-command-events))
+              ;; Remove any double quotes and whitespace at the
+              ;; start and end of the path that interactive use may
+              ;; have introduced.
+              (path (hpath:trim (read-file-name "Path to link to: "
+                                                file-path file-path)))
+              (orig-path path)
+              path-line-and-col
+              line-num
+              column-num
+              normalized-path)
+         ;; Handle if :line:column are included in path.
+         (setq path-line-and-col (hpath:file-line-and-column path))
+         (when path-line-and-col
+           (setq path (nth 0 path-line-and-col)
+                 line-num (nth 1 path-line-and-col)
+                 column-num (nth 2 path-line-and-col)))
+         ;; Ensure any variables and heading suffixes following
+         ;; [#,] are removed before doing path matching.
+         (setq normalized-path (or (hpath:is-p path) path))
+         (when (not (or (file-name-absolute-p path)
+                        (string-match "\\`\\$\{" path)))
+           (setq path (concat default-directory path)))
+         (setq existing-buf (get-file-buffer normalized-path)
+               path-buf (or existing-buf
+                            (and (file-readable-p normalized-path)
+                                 (prog1 (set-buffer (find-file-noselect 
normalized-path t))
+                                   (when (integerp file-point)
+                                     (goto-char (min (point-max) 
file-point)))))))
+         (if (and path-buf (not line-num))
+             (with-current-buffer path-buf
+               (setq hargs:reading-type 'character)
+               (if (y-or-n-p
+                    (format "y = Display at present position (line %d); n = no 
position? "
+                            (count-lines 1 (point))))
+                   (list path (point))
+                 (list path)))
+           (if path-buf
+               (delq nil (list path (save-excursion
+                                      (goto-char (point-min))
+                                      (forward-line (1- line-num))
+                                      (when column-num (move-to-column 
column-num))
+                                      (point))))
+             (list (or path orig-path)))))
+      (setq hargs:reading-type prev-reading-p)
+      (when (and path-buf (not existing-buf))
+       (kill-buffer path-buf)))))
+
 (defact link-to-file (path &optional point)
   "Display a file given by PATH scrolled to optional POINT.
 If POINT is given, display the buffer with POINT at the top of
 the window or as close as possible."
-  (interactive
-   (let ((prev-reading-p hargs:reading-type)
-        (existing-buf t)
-        path-buf)
-     (unwind-protect
-        (let* ((default-directory (or (hattr:get 'hbut:current 'dir)
-                                      (file-name-directory
-                                       (or (hattr:get 'hbut:current 'loc) ""))
-                                      default-directory))
-               (file-path (or (car hargs:defaults) default-directory))
-               (file-point (cadr hargs:defaults))
-               (hargs:reading-type 'file)
-               ;; If reading interactive inputs from a key series
-               ;; (puts key events into the unread queue), then don't
-               ;; insert default-directory into the minibuffer
-               ;; prompt, allowing time to remove any extra pathname
-               ;; quotes added in the key series.
-               (insert-default-directory (not unread-command-events))
-               ;; Remove any double quotes and whitespace at the
-               ;; start and end of the path that interactive use may
-               ;; have introduced.
-               (path (hpath:trim (read-file-name "Path to link to: "
-                                                 file-path file-path)))
-               (orig-path path)
-               path-line-and-col
-               line-num
-               column-num
-               normalized-path)
-          ;; Handle if :line:column are included in path.
-          (setq path-line-and-col (hpath:file-line-and-column path))
-          (when path-line-and-col
-            (setq path (nth 0 path-line-and-col)
-                  line-num (nth 1 path-line-and-col)
-                  column-num (nth 2 path-line-and-col)))
-          ;; Ensure any variables and heading suffixes following
-          ;; [#,] are removed before doing path matching.
-          (setq normalized-path (hpath:is-p path))
-          (when (not (or (file-name-absolute-p path)
-                         (string-match "\\`\\$\{" path)))
-            (setq path (concat default-directory path)))
-          (setq existing-buf (get-file-buffer normalized-path)
-                path-buf (or existing-buf
-                             (and (file-readable-p normalized-path)
-                                  (prog1 (set-buffer (find-file-noselect 
normalized-path t))
-                                    (when (integerp file-point)
-                                      (goto-char (min (point-max) 
file-point)))))))
-          (if (and path-buf (not line-num))
-              (with-current-buffer path-buf
-                (setq hargs:reading-type 'character)
-                (if (y-or-n-p
-                     (format "y = Display at present position (line %d); n = 
no position? "
-                             (count-lines 1 (point))))
-                    (list path (point))
-                  (list path)))
-            (if path-buf
-                (delq nil (list path (save-excursion
-                                       (goto-char (point-min))
-                                       (forward-line (1- line-num))
-                                       (when column-num (move-to-column 
column-num))
-                                       (point))))
-              (list (or path orig-path)))))
-       (setq hargs:reading-type prev-reading-p)
-       (when (and path-buf (not existing-buf))
-        (kill-buffer path-buf)))))
+  (interactive (hactypes:link-to-file-interactively))
   (if path
       (progn
        ;; Remove any double quotes and whitespace at the start and end of



reply via email to

[Prev in Thread] Current Thread [Next in Thread]