diff options
Diffstat (limited to 'hargs.el')
| -rw-r--r-- | hargs.el | 87 |
1 files changed, 60 insertions, 27 deletions
@@ -4,7 +4,7 @@ ;; ;; Orig-Date: 31-Oct-91 at 23:17:35 ;; -;; Copyright (C) 1991-2017 Free Software Foundation, Inc. +;; Copyright (C) 1991-2019 Free Software Foundation, Inc. ;; See the "HY-COPY" file for license information. ;; ;; This file is part of GNU Hyperbole. @@ -90,13 +90,23 @@ interactive form or takes no arguments." (action:path-args-rel (hargs:iform-read interactive-form modifying)))))) +(defun hargs:buffer-substring (start end) + (let ((string (buffer-substring-no-properties start end))) + ;; This may trigger on a colored grep-like output line which has + ;; an embedded null character with a display text property that + ;; displays it as a colon. Since the display property is stripped + ;; here, convert the null character to a colon. + (subst-char-in-string ?\^@ ?: string t))) + (defun hargs:delimited (start-delim end-delim - &optional start-regexp-flag end-regexp-flag list-positions-flag) - "Returns a normalized, single line, delimited string that point is within, or nil. + &optional start-regexp-flag end-regexp-flag + list-positions-flag exclude-regexp) + "Returns a normalized, single line, delimited string that point is within the first line of, or nil. START-DELIM and END-DELIM are strings that specify the argument delimiters. With optional START-REGEXP-FLAG non-nil, START-DELIM is treated as a regular expression. END-REGEXP-FLAG is similar. -With optional LIST-POSITIONS-FLAG, return list of (string-matched start-pos end pos)." +With optional LIST-POSITIONS-FLAG, return list of (string-matched start-pos end-pos). +With optional EXCLUDE-REGEXP, any matched string is ignored if it this regexp." (let* ((opoint (point)) (limit (if start-regexp-flag opoint (+ opoint (1- (length start-delim))))) @@ -104,36 +114,57 @@ With optional LIST-POSITIONS-FLAG, return list of (string-matched start-pos end 'search-forward)) (end-search-func (if end-regexp-flag 're-search-forward 'search-forward)) + (count 0) start end) (save-excursion (beginning-of-line) (while (and (setq start (funcall start-search-func start-delim limit t)) + (setq count (1+ count)) (< (point) opoint) ;; This is not to find the real end delimiter but to find ;; end delimiters that precede the current argument and are ;; therefore false matches, hence the search is limited to ;; prior to the original point. - (funcall end-search-func end-delim opoint t)) + (funcall end-search-func end-delim opoint t) + (setq count (1+ count))) (setq start nil)) + (when (and (not start) (> count 0) (evenp count) (string-equal start-delim end-delim)) + ;; Since strings can span lines but this function matches only + ;; strings that start on the current line, when start-delim and + ;; end-delim are the same and there are an even number of + ;; delimiters in the search range, causing the end-delim + ;; search to match to what should probably be the start-delim, + ;; assume point is within a string and not between two other strings. + ;; RSW - 02/05/2019 + (setq start (point))) (when start (forward-line 2) (setq limit (point)) (goto-char opoint) (and (funcall end-search-func end-delim limit t) (setq end (match-beginning 0)) - ;; Ignore any preceding backquote, e.g. when a double-quoted - ;; string is embedded within a doc string. + ;; Ignore any preceding backslash, e.g. when a double-quoted + ;; string is embedded within a doc string, except when + ;; the string starts with 2 backslashes or an MSWindows + ;; disk drive prefix, in which case the backslash is + ;; considered part of a pathname. (if (and (> end (point-min)) - (= (char-before end) ?\\)) + (= (char-before end) ?\\) + (not (string-match (concat "\\(\\`[\\][\\]\\)\\|" + hpath:mswindows-mount-prefix) + (hargs:buffer-substring start end)))) (setq end (1- end)) t) (< start end) - (let ((string (substring-no-properties - (hypb:replace-match-string - "[\n\r]\\s-*" (buffer-substring start end) " " t)))) - (if list-positions-flag - (list string start end) - string))))))) + (>= end opoint) + (let ((string (hargs:buffer-substring start end))) + (unless (and (stringp exclude-regexp) (string-match exclude-regexp string) ) + (setq string (hypb:replace-match-string "[\n\r\f]\\s-*" string " " t)) + (unless hyperb:microsoft-os-p + (setq string (hpath:mswindows-to-posix string))) + (if list-positions-flag + (list string start end) + string)))))))) (defun hargs:get (interactive-entry &optional default prior-arg) "Prompts for an argument, if need be, from INTERACTIVE-ENTRY, a string. @@ -197,17 +228,13 @@ Optional DEFAULT-PROMPT is used to describe default value." (defun hargs:select-event-window () "Select window, if any, that mouse was over during last event." - (if (featurep 'xemacs) - (if current-mouse-event - (select-window - (or (event-window current-mouse-event) (selected-window)))) - (let ((window (posn-window (event-start last-command-event)))) - (if (framep window) - (setq window (frame-selected-window window))) - (if (and (window-minibuffer-p window) - (not (minibuffer-window-active-p window))) - (error "Attempt to select inactive minibuffer window") - (select-window (or window (selected-window))))))) + (let ((window (posn-window (event-start last-command-event)))) + (if (framep window) + (setq window (frame-selected-window window))) + (if (and (window-minibuffer-p window) + (not (minibuffer-window-active-p window))) + (error "Attempt to select inactive minibuffer window") + (select-window (or window (selected-window)))))) (defun hargs:set-string-to-complete () "Store the current minibuffer contents into `hargs:string-to-complete'." @@ -293,7 +320,13 @@ Handles all of the interactive argument types that `hargs:iform-read' does." (t 0))))) ((hargs:completion t)) ((eq hargs:reading-p 'ebut) (ebut:label-p 'as-label)) - ((ebut:label-p) nil) + ((eq hargs:reading-p 'ibut) (ibut:label-p 'as-label)) + ((eq hargs:reading-p 'gbut) + (when (eq (current-buffer) (get-file-buffer gbut:file)) + (hbut:label-p 'as-label))) + ((eq hargs:reading-p 'hbut) (or (ebut:label-p 'as-label) + (ibut:label-p 'as-label))) + ((hbut:label-p) nil) ((eq hargs:reading-p 'file) (cond ((derived-mode-p 'dired-mode) (let ((file (dired-get-filename nil t))) @@ -490,7 +523,7 @@ See also documentation for `interactive'." ;; `@' means select window of last mouse event. ;; ;; `^' means activate/deactivate mark depending on invocation thru shift translation - ;; See `this-command-keys-shift-translated' for somewhat of an explanation. + ;; See `this-command-keys-shift-translated' for an explanation. ;; ;; `_' means keep region in same state (active or inactive) ;; after this command. (XEmacs only.) |