(require 'cl-lib)

(require 'hact)

(require 'seq) ;; For seq-find

(require 'subr-x) ;; For string-trim

(require 'hversion) ;; for (hyperb:window-system) definition

(require 'hui-select) ;; for `hui-select-markup-modes'

(require 'tramp)

(unless (fboundp 'br-in-browser)

;; Then the OO-Browser is not loaded, so we can never be within the

;; browser. Define this as a dummy function that always returns nil

;; until the OO-Browser is ever loaded.

(defun br-in-browser ()

"Always returns nil since the OO-Browser is not loaded."

nil))

(defcustom hpath:auto-completing-read-modes '(consult-org-roam-mode helm-mode

icomplete-mode ivy-mode

org-roam-mode vertico-mode

selectrum-mode)

"List of boolean mode variables whose modes automatically list completions.

:type '(repeat variable)

:group 'hyperbole-commands)

(defvar hpath:auto-variable-alist

'(("\\.el[cn]?\\'" . load-path)

("\\.org\\'" . org-directory)

("\\.py\\'" . "PYTHONPATH"))

"Alist of filename patterns and related variables to prepend to resolve them.

or a colon or semicolon delimited string of directory paths.")

(defcustom hpath:find-file-urls-mode nil

"Set to t to enable use of ftp and http urls in file finding commands.

:type 'boolean

:initialize #'custom-initialize-default

:set (lambda (_symbol _value) (call-interactively #'hpath:find-file-urls-mode))

:group 'hyperbole-buttons)

(defconst hpath:line-and-column-numbers

":L?\\([-+]?[0-9]+\\)\\(:C?\\([-+]?[0-9]+\\)\\)?"

"Regexp matching a line number and optional column number.

1-based line number. Group 3 is the 0-based column number.")

(defconst hpath:line-and-column-regexp

(concat hpath:line-and-column-numbers "\\s-*\\'")

"Regexp matching a trailing line number and optional column number.

1-based line number. Group 3 is the 0-based column number.")

(defconst hpath:instance-line-column-regexp

":I\\([-+]?[0-9]+\\)\\(:L?\\([-+]?[0-9]+\\)\\)?\\(:C?\\([-+]?[0-9]+\\)\\)?\\s-*\\'"

"Regexp matching a trailing instance, optional line, and column number.

Group 3 is the 1-based line number. Group 5 is the 0-based column number.")

(defconst hpath:markup-link-anchor-regexp

"\\`\\(#?[^#+]*[^#+.]\\)?\\(#\\)\\([^\]\[#+^{}<>\"`'\\\n\t\f\r]*\\)"

"Regexp matching a filename followed by a hash (#) and an optional anchor name.

is part of the filename.")

(defvar hpath:path-variable-regexp "\\`\\$?[{(]?\\([-_A-Z]*path[-_A-Z]*\\)[)}]?\\'"

"Regexp that matches exactly to a standalone path variable name reference.

Group 1 is the variable name.")

(defvar hpath:path-variable-value-regexp

(let* ((posix-separators ":;")

(windows-separators ";")

(reserved-chars "<>:\"|?*")

(exclude-space "\t\n\r\f")

(control-chars "[:cntrl:]")

;; Posix char set to exclude from paths

(nope (concat "\[^" posix-separators reserved-chars exclude-space control-chars "\]+"))

;; Windows char set to exclude from paths

(nowin (concat "\[^" windows-separators reserved-chars exclude-space control-chars "\]+")))

(concat "\\`\\.?:" nope ":" nope ":\\|:\\.?:" nope ":\\|:" nope ":" nope ":\\|:" nope ":" nope ":\\.?\\'"

"\\|"

"\\`\\.?;" nowin ";" nowin ";\\|;\\.?;\\|;" nowin ";" nowin ";\\|;" nowin ";" nowin ";\\|;" nowin ";" nowin ";\\.?\\'"))

;; A zero-length (null) directory name in the value of PATH indicates the current directory.

;; A null directory name may appear as two adjacent colons, or as an initial or trailing colon.

"Regexp that heuristically matches to Posix or Windows path variable values.

path variable values.")

(defconst hpath:section-line-and-column-regexp

"\\([^ \t\n\r\f:][^\t\n\r\f:]+\\(:[^0-9\t\n\r\f]*\\)*\\):L?\\([0-9]+\\)\\(:C?\\([0-9]+\\)\\)?$"

"Regexp that matches to a path with optional #section and :line:col.

and optional character, L for line and C for column.")

(defconst hpath:variable-regexp "\\$@?\{\\([^\}]+\\)@?\}"

"Regexp matching variable names that Hyperbole resolves within pathnames.

The format is ${variable}. Match grouping 1 is the name of the variable.")

(defvar hywiki-directory)

(declare-function Info-find-node "info")

(declare-function br-in-browser "ext:br")

(declare-function br-quit "ext:br")

(declare-function br-to-view-window "ext:br")

(declare-function hargs:delimited "hargs")

(declare-function hattr:get "hbut")

(declare-function hbut:key-to-label "hbut")

(declare-function hbut:label-to-key "hbut")

(declare-function hmail:editor-p "hmail")

(declare-function hypb:decode-url "hypb")

(declare-function hypb:object-p "hypb")

(declare-function hywiki-get-existing-page-file "hywiki")

(declare-function hywiki-get-referent "hywiki")

(declare-function hywiki-org-to-heading-instance "hywiki")

(declare-function kbd-key:key-series-to-events "hib-kbd")

(declare-function kcell-view:indent "kcell-view")

(declare-function klink:act "klink")

(declare-function klink:update-label "klink")

(declare-function kotl-mode:to-valid-position "kotl-mode")

(declare-function mm-mailcap-command "mm-decode")

(declare-function org-element-property "org-element-ast")

(defvar hpath:posix-mount-points-regexp

"^\\(Filesystem\\|rootfs\\|none\\) "

"Regexp of \\='mount' output lines that are not mount points of MSWindows paths.")

(defvar hpath:mswindows-mount-prefix

(cond ((eq system-type 'cygwin)

"/cygdrive/")

(hyperb:microsoft-os-p

"")

(t ;; POSIX

"/mnt/"))

"Path prefix to add when converting MSWindows drive paths to POSIX-style.

Must include a trailing directory separator or be nil.")

(defconst hpath:mswindows-drive-regexp (format "\\`\\(%s\\)?[\\/]?\\([a-zA-Z]\\)[:\\/]"

hpath:mswindows-mount-prefix)

"Regular expression matching an MSWindows drive letter.

constant.")

(defconst hpath:mswindows-path-regexp "\\`.*\\.*[a-zA-Z0-9_.]"

"Regexp matching the start of an MSWindows path without a drive letter.

Path contains directory separators.")

(defvar hpath:posix-mount-point-to-mswindows-alist nil

"Automatically set alist of (posix-mount-point . window-path-prefix) elements.

posix-to-mswindows conversion.")

(defun hpath:mswindows-to-posix (path)

"Convert a MSWindows PATH to a Posix-style path or return the path unchanged.

(interactive "sMSWindows path to convert to POSIX: ")

(when (and (stringp path) (not (equal path "\\\\")))

(setq path (hpath:mswindows-to-posix-separators path))

(when (string-match hpath:mswindows-drive-regexp path)

(let* ((drive-prefix (downcase (match-string 2 path)))

(rest-of-path (substring path (match-end 0)))

(absolute-p (and (not (string-empty-p rest-of-path))

(= (aref rest-of-path 0) ?/))))

;; Convert MSWindows disk drive paths to POSIX-style with a mount prefix.

(setq path (concat hpath:mswindows-mount-prefix drive-prefix

(cond (hyperb:microsoft-os-p ":")

(absolute-p "")

(t "/"))

rest-of-path)))))

path)

(defun hpath:mswindows-to-posix-separators (path)

"Replace backslashes with forward slashes and abbreviate the PATH if possible.

(setq path (replace-regexp-in-string "\\\\" "/" path)

;; Downcase any host and domain for mount-point matching

path (if (string-match "\\`//[^/:]+" path)

(concat (downcase (match-string 0 path))

(substring path (match-end 0)))

path)

path (hpath:abbreviate-file-name path)

path (replace-regexp-in-string (regexp-quote "\\`") "" path)

path (replace-regexp-in-string (regexp-quote "\\>") "" path)))

(defun hpath:posix-to-mswindows (path)

"Convert a Posix-style PATH to an MSWindows path or return the path unchanged.

(interactive "sPOSIX path to convert to MSWindows: ")

(when (stringp path)

(when (string-match hpath:mswindows-drive-regexp path)

(let* ((drive-prefix (downcase (match-string 2 path)))

(absolute-p (= (aref path (1- (match-end 0))) ?/))

(rest-of-path (substring path (match-end 0))))

;; Convert formerly Posix-style Windows disk drive paths to MSWindows-style.

(setq path (concat drive-prefix ":"

(if (or (not absolute-p)

(string-match "\\`[~/]" rest-of-path))

""

"/")

rest-of-path))))

(hpath:posix-to-mswindows-separators path)))

(defun hpath:posix-to-mswindows-separators (path)

"Replace forward slashes with backslashes and abbreviate the PATH if possible.

(let ((directory-abbrev-alist hpath:posix-mount-point-to-mswindows-alist))

(replace-regexp-in-string "/" "\\\\" (hpath:abbreviate-file-name path))))

(defun hpath:posix-path-p (path)

"Return non-nil if PATH looks like a Posix path."

(and (stringp path) (string-match "/" path)))

(defun hpath:substitute-posix-or-mswindows-at-point ()

"If point is in a Posix or MSWindows path, change the path to the other type."

(interactive "*")

(barf-if-buffer-read-only)

(let* ((opoint (point))

(str-and-positions (hpath:delimited-possible-path t t))

(path (car str-and-positions))

(start (nth 1 str-and-positions))

(end (nth 2 str-and-positions)))

(when path

(if (hpath:posix-path-p path)

(setq path (hpath:posix-to-mswindows path))

(setq path (hpath:mswindows-to-posix path)))

(delete-region start end)

(insert path)

(goto-char (min opoint (point-max))))))

(defun hpath:substitute-posix-or-mswindows (path)

"Change a recognizable Posix or MSWindows PATH to the other type of path."

(when (stringp path)

(if (hpath:posix-path-p path)

(hpath:posix-to-mswindows path)

(hpath:mswindows-to-posix path))))

(defun hpath:cache-mswindows-mount-points ()

"Cache valid MSWindows mounts when under a non-MSWindows OS, e.g. WSL.

(interactive)

(when (not hyperb:microsoft-os-p)

(let (mount-points-to-add)

;; Convert plist to alist for sorting.

(hypb:map-plist (lambda (path mount-point)

(when (string-match "\\`\\([a-zA-Z]\\):\\'" path)

(setq path (concat "/" (match-string 1 path))))

;; Drive letter must be downcased

;; in order to work when converted back to Posix.

;; Assume all mounted Windows paths are

;; lowercase for now.

(setq path (downcase path))

(push (cons (downcase path) mount-point)

mount-points-to-add)

;; If a network share with a domain

;; name, also add an entry WITHOUT the

;; domain name to the mount points

;; table since Windows paths often omit

;; the domain.

(when (string-match "\\`\\([\\/][\\/][^.\\/]+\\)\\([^\\/]+\\)" path)

(push (cons (concat (match-string 1 path)

(substring path (match-end 0)))

mount-point)

mount-points-to-add)))

;; Return a plist of MSWindows path-mounted mount-point pairs.

;; Next call will raise an error if default-directory is set to

;; a URL, e.g. in RFC buffers or if tcsh shell is used; just

;; ignore it and return nil in such a case.

(condition-case ()

(split-string (shell-command-to-string (format "df -a -t drvfs 2> /dev/null | sort | uniq | grep -v '%s' | sed -e 's+ .*[-%%] /+ /+g'" hpath:posix-mount-points-regexp)))

(error nil)))

;; Sort alist of (path-mounted . mount-point) elements from shortest

;; to longest path so that the longest path is selected first within

;; 'directory-abbrev-alist' (elements are added in reverse order).

(setq mount-points-to-add

(sort mount-points-to-add

(lambda (cons1 cons2) (<= (length (car cons1)) (length (car cons2))))))

(let (path

mount-point)

(mapc (lambda (path-and-mount-point)

(setq path (car path-and-mount-point)

mount-point (cdr path-and-mount-point))

;; Don't abbreviate /mnt or /cygdrive to /, skip this entry.

(unless (equal mount-point "/")

(add-to-list 'directory-abbrev-alist (cons (format "\\`%s\\>" (regexp-quote path))

mount-point))))

mount-points-to-add))

;; Save the reverse of each mount-points-to-add so

;; can expand paths when going from posix-to-mswindows.

(setq hpath:posix-mount-point-to-mswindows-alist

(mapcar (lambda (elt) (cons (concat "\\`" (cdr elt) "\\>")

(car elt))) mount-points-to-add))

mount-points-to-add)))

(defcustom hpath:external-open-office-suffixes "doc[mx]?\\|od[st]\\|ppsx?\\|ppt[mx]?\\|v[dst][s]?[tx]\\|vsd[x]?\\|xls[mx]?"

"Regexp of Open Office document suffix alternatives.

:type 'string

:group 'hyperbole-commands)

(defcustom hpath:external-file-suffixes "e?ps\\|dvi\\|pdf\\|ps\\.g?[zZ]\\|gif\\|tiff?\\|xpm\\|xbm\\|xwd\\|pm\\|pbm\\|jpe?g\\|xcf"

"Non-operating system dependent regexp of file suffixes to open outside Emacs.

:type 'string

:group 'hyperbole-commands)

(defcustom hpath:external-display-alist-macos (list (cons (format "\\.\\(%s\\|%s\\|app\\|adaptor\\|bshlf\\|clr\\|concur\\|create\\|diagram\\|dp\\|frame\\|locus\\|Mesa\\|nib\\|project\\|rtf\\|sense\\|tree\\)$"

hpath:external-open-office-suffixes

hpath:external-file-suffixes)

"open"))

"An alist of (FILENAME-REGEXP . DISPLAY-PROGRAM-STRING-OR-LIST) for the macOS.

:type '(alist :key-type regexp :value-type string)

:group 'hyperbole-commands)

(defcustom hpath:external-display-alist-mswindows (list (cons (format "\\.\\(%s\\)$" hpath:external-open-office-suffixes)

"openoffice.exe")

(cons (format "\\.\\(%s\\|vba\\)$" hpath:external-file-suffixes)

"/c/Windows/System32/cmd.exe //c start \"${@//&/^&}\""))

"An alist of (FILENAME-REGEXP . DISPLAY-PROGRAM-STRING-OR-LIST) for MS Windows.

:type '(alist :key-type regexp :value-type string)

:group 'hyperbole-commands)

(defcustom hpath:external-display-alist-x (list (cons (format "\\.\\(%s\\|%s\\)$"

hpath:external-open-office-suffixes

hpath:external-file-suffixes)

"setsid -w xdg-open"))

"An alist of (FILENAME-REGEXP . DISPLAY-PROGRAM-STRING-OR-LIST) for X.

:type '(alist :key-type regexp :value-type string)

:group 'hyperbole-commands)

(defvar hpath:info-suffix "\\.info\\(-[0-9]+\\)?\\(\\.gz\\|\\.Z\\|-z\\)?\\'"

"Regexp matching to the end of Info manual file names.")

(defcustom hpath:internal-display-alist

(delq

nil

(list

;; Support internal sound when available.

(if (fboundp 'play-sound-file)

'("\\.\\(au\\|mp3\\|ogg\\|wav\\)$" . play-sound-file))

;; Run the OO-Browser on OOBR or OOBR-FTR Environment files.

'("\\(\\`\\|/\\)\\(OOBR\\|oobr\\).*\\(-FTR\\|-ftr\\)?\\'" . br-env-browse)

;; Display the top node from Info online manuals.

(cons

(concat hpath:info-suffix

"\\|/\\(info\\|INFO\\)/[^.]+$\\|/\\(info-local\\|INFO-LOCAL\\)/[^.]+$")

(lambda (file)

(when (and (string-match hpath:info-suffix file)

(match-beginning 1))

;; Removed numbered trailer to get basic filename.

(setq file (concat (substring-no-properties file 0 (match-beginning 1))

(substring-no-properties file (match-end 1)))))

;; Ensure that Info files with non-absolute directories outside of the

;; `Info-directory-list' are resolved properly, e.g. "man/hyperbole.info".

(unless (file-name-absolute-p file)

(setq file (expand-file-name "man/hyperbole.info")))

(require 'info)

;; Ensure that *info* buffer is displayed in the right place.

(hpath:display-buffer (current-buffer))

(condition-case ()

(Info-find-node file "Top")

(error (if (and file (file-exists-p file))

(progn

(if (get-buffer "*info*")

(kill-buffer "*info*"))

(Info-find-node file "*" nil t))

(error "Invalid file"))))))

'("\\.rdb\\'" . rdb:initialize)))

"Alist for calling special functions to display file types in Emacs.

:type '(alist :key-type regexp :value-type sexp)

:group 'hyperbole-commands)

(defvar hpath:display-buffer-alist

(list

(list 'this-window #'switch-to-buffer)

(list 'other-window (lambda (b)

(if (br-in-browser)

(progn (br-to-view-window)

(switch-to-buffer b))

(switch-to-buffer-other-window b))))

(list 'one-window (lambda (b)

(when (br-in-browser)

(br-quit))

(delete-other-windows)

(switch-to-buffer b)))

(list 'new-frame (lambda (b)

;; Give temporary modes such as isearch a chance to turn off.

(run-hooks 'mouse-leave-buffer-hook)

(select-frame (make-frame (frame-parameters)))

(switch-to-buffer b)))

(list 'other-frame #'hpath:display-buffer-other-frame)

(list 'other-frame-one-window (lambda (b)

(prog1 (hpath:display-buffer-other-frame b)

(delete-other-windows)))))

"*Alist of (DISPLAY-WHERE-SYMBOL DISPLAY-BUFFER-FUNCTION) elements.

other-frame-one-window - display in another frame, deleting other windows.")

(defvar hpath:display-where 'other-window

"Symbol specifying the default method to use to display Hyperbole link referents.

See Info node `(elisp)Choosing Window Options' for where Emacs displays buffers.")

(defvar hpath:display-where-alist

(list

(list 'this-window #'find-file)

(list 'other-window (lambda (f)

(if (br-in-browser)

(progn (br-to-view-window)

(find-file f))

(find-file-other-window f))))

(list 'one-window (lambda (f)

(if (br-in-browser) (br-quit))

(delete-other-windows)

(find-file f)))

(list 'new-frame (lambda (f)

(if (fboundp 'find-file-new-frame)

(find-file-new-frame f)

(hpath:find-other-frame f))))

(list 'other-frame #'hpath:find-other-frame)

(list 'other-frame-one-window (lambda (f)

(prog1 (hpath:find-other-frame f)

(delete-other-windows)))))

"*Alist of (DISPLAY-WHERE-SYMBOL DISPLAY-FILE-FUNCTION) elements.

other-frame-one-window - display in another frame, deleting other windows.")

(defcustom hpath:native-image-suffixes "\\.\\(xbm\\|xpm\\|xwd\\|png\\|gif\\|jpe?g\\)\\'"

"Regular expression matching file name suffixes of images to display in Emacs.

:type 'regexp

:group 'hyperbole-commands)

(defcustom hpath:variables

'(hyperb:dir hywiki-directory load-path exec-path Info-directory-list sm-directory)

"List of Emacs Lisp variable symbols to substitute within matching link paths.

:type '(repeat variable)

:group 'hyperbole-commands)

(defvar hpath:rfc "https://www.ietf.org/rfc/rfc%s.txt"

"*Url pattern for (hpath:rfc rfc-num) to get the RFC document for `rfc-num'.")

(defcustom hpath:suffixes '(".gz" ".Z")

"List of filename suffixes to add or remove within hpath calls.

:type '(repeat string)

:group 'hyperbole-commands)

(defvar hpath:tmp-prefix "/tmp/remote-"

"*Pathname prefix for use with external viewers.

The prefix is attached to remote files when copied locally for viewing.")

(defvar hpath:url-regexp "<?\\(URL[:=]\\)?\\(\\([a-zA-Z][a-zA-Z]+\\)://?/?\\([^/:@ \t\n\r\"`'|]+@\\)?\\([^/:@ \t\n\r\"`'|]+\\)\\(\\)\\(:[0-9]+\\)?\\([/~]\\([^\]\[ \t\n\r\"`'|(){}<>]+[^\]\[ \t\n\r\"`'|(){}<>.,?#!*]\\)*\\)?\\)>?"

"Regular expression which matches a Url in a string or buffer.

8 = hpath:pathname-grpn = optional pathname to access.")

(defvar hpath:url-hostnames-regexp "\\(www\\|s?ftp\\|telnet\\|news\\|nntp\\)"

"Regexp group of hostnames that contains the Url access protocol to use.")

(defvar hpath:url-regexp2

(concat

"<?\\(URL[:=]\\|[^/@]\\|\\)\\(\\(\\)\\(\\)\\("

hpath:url-hostnames-regexp

"\\.[^/:@ \t\n\r\"`'|]+\\):?\\([0-9]+\\)?\\([/~]\\([^\]\[ \t\n\r\"`'|(){}<>]+[^\]\[ \t\n\r\"`'|(){}<>.,?#!*]\\)*\\)?\\)>?")

"Regular expression which matches a Url in a string or buffer.

8 = hpath:pathname-grpn = optional pathname to access.")

(defvar hpath:url-regexp3

(concat

"<?\\(URL[:=]\\)\\(\\(\\)\\(\\)"

"\\([a-zA-Z0-9][^/:@ \t\n\r\"`'|]*\\.[^/:@ \t\n\r\"`'|]+\\)"

":?\\([0-9]+\\)?\\([/~]\\([^\]\[ \t\n\r\"`'|(){}<>]+[^\]\[ \t\n\r\"`'|(){}<>.,?#!*]\\)*\\)?\\)>?")

"Regular expression which matches a Url in a string or buffer.

8 = hpath:pathname-grpn = optional pathname to access.")

(defconst hpath:url-keyword-grpn 1

"Optional `URL:' or `URL=' literal.

See doc for `hpath:url-regexp' and `hpath:url-regexp[2,3]'.")

(defconst hpath:url-grpn 2

"The whole URL. See doc for `hpath:url-regexp' and `hpath:url-regexp[2,3]'.")

(defconst hpath:protocol-grpn 3

"Access protocol. See doc for `hpath:url-regexp' and `hpath:url-regexp[2,3]'.")

(defconst hpath:username-grpn 4

"Optional username. See doc for `hpath:url-regexp' and `hpath:url-regexp[2,3]'.")

(defconst hpath:sitename-grpn 5

"URL site to connect to.

See doc for `hpath:url-regexp' and `hpath:url-regexp[2,3]'.")

(defconst hpath:hostname-grpn 6

"Hostname used to determine the access protocol, e.g. sftp.domain.com.

See doc for `hpath:url-regexp' and `hpath:url-regexp[2,3]'.")

(defconst hpath:portnumber-grpn 7

"Optional port number to use.

See doc for `hpath:url-regexp' and `hpath:url-regexp[2,3]'.")

(defconst hpath:pathname-grpn 8

"Optional pathname to access.

See doc for `hpath:url-regexp' and `hpath:url-regexp[2,3]'.")

(defvar hpath:string-url-regexp (concat "\\`" hpath:url-regexp "\\'")

"Regexp that matches to a possibly delimited Url and nothing else.

use with `string-match'.")

(defvar hpath:string-url-regexp2 (concat "\\`" hpath:url-regexp2 "\\'")

"Regexp that matches to a possibly delimited terse Url and nothing else.

use with `string-match'.")

(defvar hpath:string-url-regexp3 (concat "\\`" hpath:url-regexp3 "\\'")

"Regexp that matches to a possibly delimited terse Url and nothing else.

use with `string-match'.")

(defconst hpath:html-anchor-id-pattern "\\(id\\|name\\)=['\"]%s['\"]"

"Regexp matching an html anchor id definition.

Contains a %s for replacement of a specific anchor id.")

(defconst hpath:markdown-anchor-id-pattern "^[ ]*%s: "

"Regexp matching a Markdown anchor id definition.

Contains a %s for replacement of a specific anchor id.")

(defconst hpath:markdown-section-pattern "^[ \t]*\\(#+\\|\\*+\\)[ \t]*%s\\([\[<\({ \t[:punct:]]*\\)$"

"Bol-anchored regexp matching an exact Markdown section.

of a specific section name.")

(defconst hpath:markdown-suffix-regexp "\\.[mM][dD]"

"Regexp that matches to a Markdown file suffix.")

(defconst hpath:outline-section-pattern "^\\(\\*+\\|#\\+TITLE:\\)[ \t]+%s[ \t]*\\([\[<\({[:punct:]]+\\|$\\)"

"Bol-anchored, no leading spaces regexp matching an exact outline section.

for replacement of a specific section name.")

(defvar hpath:prefix-regexp "\\`[-!&][ ]*"

"Regexp matching command characters which may precede a pathname.

& means run it under the current window system.")

(defvar hpath:remote-regexp

"\\`/[^/:]+:\\|\\`s?ftp[:.]\\|\\`www\\.\\|\\`https?:"

"Regexp matching remote pathnames and urls which invoke remote file handlers.")

(defconst hpath:shell-comment-pattern

"^[ \t]*#+[ \t]*%s\\([ \t]\\|\\([\[<\({ \t[:punct:]]\\)\\|$\\)"

"Bol-anchored regexp matching the first part of a shell comment.

Contains a %s for replacement of the comment string.")

(defconst hpath:shell-modes '(sh-mode csh-mode shell-script:mode)

"List of modes for editing shell scripts where # is a comment character.")

(defconst hpath:texinfo-section-pattern "^@node+[ \t]+%s[ \t]*\\(,\\|$\\)"

"Regexp matching a Texinfo section header.

Contains a %s for replacement of a specific section name.")

(defun hpath:abbreviate-file-name (path)

"Return a version of PATH shortened using `directory-abbrev-alist'.

(let (tramp-mode)

(abbreviate-file-name path)))

(defun hpath:absolute-arguments (actype arg-list &optional default-dirs)

"Return any paths in ACTYPE's ARG-LIST made absolute.

(let ((param-list (delq nil (mapcar (lambda (param)

(when param

(setq param (symbol-name param))

(unless (= ?& (aref param 0))

param)))

(action:params (actype:action actype))))))

;; Extend param-list to length of arg-list in case of any &rest param.

(setq param-list

(nconc param-list

(make-list (max 0 (- (length arg-list) (length param-list)))

(last param-list))))

(cl-mapcar (lambda (param arg)

(if (and (stringp param)

(or (string-match-p "file" param)

(string-match-p "dir" param)

(string-match-p "path" param)))

(hpath:absolute-to arg default-dirs)

arg))

param-list arg-list)))

(defun hpath:absolute-to (path &optional default-dirs)

"Return PATH as an absolute path relative to one directory.

(if (not (stringp path))

path

(hpath:call

(lambda (path non-exist)

(when (stringp path)

(setq path (hpath:trim path)))

(let ((dirs default-dirs)

dir

expanded-path)

(setq expanded-path

(cond ((or (stringp dirs) (null dirs))

(expand-file-name path dirs))

((listp dirs)

(while (and dirs (null expanded-path))

(setq dir (expand-file-name

(file-name-as-directory (car dirs)))

expanded-path (expand-file-name path dir)

dirs (cdr dirs))

(unless (file-exists-p expanded-path)

(setq expanded-path nil)))

(or expanded-path path))

(t (error "(hpath:absolute-to): `default-dirs' must be a string or list, not `%s'" default-dirs))))

(if (and (stringp expanded-path)

(not (hypb:object-p expanded-path))

(not (get-buffer expanded-path))

(file-name-absolute-p expanded-path)

(hpath:is-p expanded-path nil non-exist))

expanded-path

path)))

path 'allow-spaces)))

(defun hpath:tramp-file-name-regexp ()

"Return a regexp for matching to the beginning of a remote file name.

(let ((tramp-regexp (car tramp-file-name-structure)))

(cond

((string-prefix-p "^/" tramp-regexp)

(substring tramp-regexp 1))

((string-prefix-p "\\(?:^/\\)" tramp-regexp)

(concat "/" (substring tramp-regexp (length "\\(?:^/\\)"))))

((string-prefix-p "\\(?:\\`/\\)" tramp-regexp)

(concat "/" (substring tramp-regexp (length "\\(?:\\`/\\)"))))

(t

(error "Unexpected TRAMP file name regexp: %S" tramp-regexp)))))

(defun hpath:remote-at-p ()

"Return a remote pathname that point is within or nil.

(let ((remote-package (hpath:remote-available-p))

(user (hpath:remote-default-user))

path

path-no-site)

(when remote-package

(setq path

(save-excursion

(skip-chars-backward "^[ \t\n\r\f\"`'|\(\{<")

(cond

((and (eq remote-package 'tramp)

(looking-at (hpath:tramp-file-name-regexp)))

(match-string-no-properties 0))

((looking-at hpath:url-regexp)

(if (string-match-p "\\`s?ftp\\'" (match-string-no-properties hpath:protocol-grpn))

(concat

(format "/%s:" (match-string-no-properties hpath:protocol-grpn))

;; user

(if (match-beginning hpath:username-grpn)

(match-string-no-properties hpath:username-grpn)

(concat user "@"))

;; sitename

(hpath:delete-trailer

(match-string-no-properties hpath:sitename-grpn))

":"

;; path

(if (match-beginning hpath:pathname-grpn)

(match-string-no-properties hpath:pathname-grpn)))

;; else ignore this other type of WWW path

))

((or (looking-at hpath:url-regexp2)

(looking-at hpath:url-regexp3))

(if (string-match-p "\\`s?ftp\\'" (match-string-no-properties hpath:hostname-grpn))

(concat

(format "/%s:" (match-string-no-properties hpath:hostname-grpn))

user "@"

;; site

(hpath:delete-trailer

(match-string-no-properties hpath:sitename-grpn))

":"

;; path

(if (match-beginning hpath:pathname-grpn)

(match-string-no-properties hpath:pathname-grpn)))

;; else ignore this other type of WWW path

))

;; user, site and path

((looking-at "/?[^/:@ \t\n\r\"`'|]+@[^/:@ \t\n\r\"`'|]+:[^]@ \t\n\r\"`'|\)\}]+")

(match-string-no-properties 0))

;; @site and path

((looking-at "@[^/:@ \t\n\r\"`'|]+:[^]@:, \t\n\r\"`'|\)\}]+")

(concat "/" user (match-string-no-properties 0)))

;; site and path

((and (looking-at

"/?\\(\\([^/:@ \t\n\r\"`'|]+\\):\\([^]@:, \t\n\r\"`'|\)\}]+\\)\\)[] \t\n\r,.\"`'|\)\}]")

(setq path (match-string-no-properties 1) ;; includes site

path-no-site (match-string-no-properties 3))

(string-match "[^.]\\.[^.]" (match-string-no-properties 2))

(not (string-match "\\(\\`\\|:\\)[:0-9]+\\'" path-no-site))) ;; prevent matching to line:col suffixes

(concat "/" user "@" path))

;; host and path

((and (looking-at "/\\([^/:@ \t\n\r\"`'|]+:[^]@:, \t\n\r\"`'|\)\}]+\\)")

(setq path (match-string-no-properties 1)))

(concat "/" user "@" path)))))

(hpath:delete-trailer path))))

(defun hpath:remote-p (path)

"Return a normalized form of PATH if a remote, non-local, pathname, else nil.

(and (stringp path)

(let ((remote-package (hpath:remote-available-p))

(user (hpath:remote-default-user))

result)

(setq result

(cond

((null remote-package) nil)

((eq remote-package 'tramp)

(if (tramp-tramp-file-p path) path))

((string-match hpath:string-url-regexp path)

(if (string-match-p "\\`s?ftp\\'" (match-string-no-properties hpath:protocol-grpn path))

(concat

"/"

;; user

(if (match-beginning hpath:username-grpn)

(match-string-no-properties hpath:username-grpn path)

(concat user "@"))

;; site

(hpath:delete-trailer

(match-string-no-properties hpath:sitename-grpn path))

":"

;; path

(if (match-beginning hpath:pathname-grpn)

(match-string-no-properties hpath:pathname-grpn path)))

;; else ignore this other type of WWW path

))

((or (string-match hpath:string-url-regexp2 path)

(string-match hpath:string-url-regexp3 path))

(if (string-match-p "\\`s?ftp\\'"

(match-string-no-properties hpath:hostname-grpn path))

(concat

"/" user "@"

;; site

(hpath:delete-trailer

(match-string-no-properties hpath:sitename-grpn path))

":"

;; path

(if (match-beginning hpath:pathname-grpn)

(match-string-no-properties hpath:pathname-grpn path)))

;; else ignore this other type of WWW path

))

;; user, site and path

((string-match "/?[^/:@ \t\n\r\"`'|]+@[^/:@ \t\n\r\"`'|]+:[^]@ \t\n\r\"`'|\)\}]*"

path)

(match-string-no-properties 0 path))

;; @site and path

((string-match "@[^/:@ \t\n\r\"`'|]+:[^]@ \t\n\r\"`'|\)\}]*"

path)

(concat "/" user (match-string-no-properties 0 path)))

;; site and path

((and (string-match

"/?\\(\\([^/:@ \t\n\r\"`'|]+\\):[^]@:, \t\n\r\"`'|\)\}]*\\)"

path)

(setq result (match-string-no-properties 1 path))

(string-match "[^.]\\.[^.]"

(match-string-no-properties 2 path)))

(concat "/" user "@" result))

;; host and path

((and (string-match

"/\\([^/:@ \t\n\r\"`'|]+:[^]@:, \t\n\r\"`'|\)\}]*\\)"

path)

(setq result (match-string-no-properties 1 path)))

(concat "/" user "@" result))))

(hpath:delete-trailer result))))

(defun hpath:at-p (&optional type non-exist)

"Return delimited path or non-delimited remote path at point, if any.

(let ((path (hpath:delimited-possible-path non-exist))

prefix

subpath)

(when path

(setq path (string-trim path)))

(when (and path (not non-exist)

(string-match hpath:prefix-regexp path)

(not (string-equal (match-string 0 path) path))

(setq prefix (substring path 0 1)

path (substring path 1)))

(setq non-exist t))

(if (and path (not (string-empty-p path))

(or (and non-exist prefix)

(file-readable-p path)))

(concat prefix path)

(unless (and path (or (string-empty-p path)

(string-match "::" path)))

(cond ((and path

;; Don't allow more than one set of grouping chars

(not (string-match-p "\)\\s-*\(\\|\\]\\s-*\\[\\|\}\\s-*\{" path))

;; With point inside a path variable, return the path that point is on or to the right of.

(setq subpath (or (and (setq subpath (hargs:delimited "[:\"\']\\|^\\s-*" "[:\"\']\\|\\s-*$" t t nil "[\t\n\r\f]\\|[;:] \\| [;:]"))

(not (string-match-p "[:;\t\n\r\f]" subpath))

subpath)

(and (setq subpath (hargs:delimited "[;\"\']\\|^\\s-*" "[;\"\']\\|\\s-*$" t t nil "[\t\n\r\f]\\|[;:] \\| [;:]"))