Auto Lisp to replace (underscore+Number) in a Layer name but ignore any single underscores between letters - lisp

I am trying to rename a large amount of layers that contain _1 and _2 in the Layer name for example:
AAA_XXX_1_CP or AAA_XXX_2_DD
I want to remove the _1 and _2 but leave all the other underscores in the new layer name so the new names would be:
AAA_XXX_CP or AAA_XXX_DD
I have a Lisp routine I am trying to adapt but it is taking all of the underscores out leaving this
AAAXXXCP or AAAXXXDD
Here is the Lisp I am trying to adapt.
(vl-load-com)
(defun C:SLPC (/ layname fixed); = Strip Layer names of numbers _1 & _2
(vlax-for layer (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))
(setq
layname (vla-get-name layer)
fixed (vl-string-translate "_1_2" " " layname)
; replace all such characters with spaces
); setq
(while (wcmatch fixed "* *") (setq fixed (vl-string-subst "" " " fixed)))
; remove all spaces [original as well as just-substituted]
(if
(and
(not (tblsearch "layer" fixed)); doesn't duplicate an existing Layer name
(/= fixed ""); wasn't made of only such characters [reduced to nothing]
); and
(vla-put-name layer fixed); rename it
); if
); vlax-for
(princ)
); defun

Have a look at the help entry for "vl-string-translate". It is interpreting each character of your sourceset as a replacement character. It is not seeing "_1" and "_2" but "_", "1", and "2" as items to be replaced in your string. That is why it is taking out all of your underscores. You can probably skip the translate and just use "vl-string-subst" to get the job done.
Replace
(setq layname (vla-get-name layer) fixed (vl-string-translate "_1_2" " " layname);
setq (while (wcmatch fixed "**")
(setq fixed (vl-string-subst "" " " fixed)))
With
(setq layname (vla-get-name layer) fixed (vl-string-subst "_1" "" layname);
(setq layname (vla-get-name layer) fixed (vl-string-subst "_2" "" layname);
setq (while (wcmatch fixed "**")

I found this worked for my needs - it could maybe be made more efficient though.
(vl-load-com)
(defun C:SLPC (/ layname layname2 fixed fixed2); = Strip Layer names of numbers _1 & _2
(vlax-for layer (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))
(setq
layname (vla-get-name layer)
fixed (vl-string-subst " " "_1" layname)
; replace all such characters with spaces
); setq
(while (wcmatch fixed "* *") (setq fixed (vl-string-subst "" " " fixed)))
; remove all spaces [original as well as just-substituted]
(if
(and
(not (tblsearch "layer" fixed)); doesn't duplicate an existing Layer name
(/= fixed ""); wasn't made of only such characters [reduced to nothing]
); and
(vla-put-name layer fixed); rename it
); if
); vlax-for
(princ)
;
; now the no2
;
(vlax-for layer (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))
(setq
layname2 (vla-get-name layer)
fixed2 (vl-string-subst " " "_2" layname2)
; replace all such characters with spaces
); setq
(while (wcmatch fixed2 "* *") (setq fixed2 (vl-string-subst "" " " fixed2)))
; remove all spaces [original as well as just-substituted]
(if
(and
(not (tblsearch "layer" fixed2)); doesn't duplicate an existing Layer name
(/= fixed2 ""); wasn't made of only such characters [reduced to nothing]
); and
(vla-put-name layer fixed2); rename it
); if
); vlax-for
(princ)
); defun

Related

Removing enclosed text in Emacs

I would like to delete enclosed text between special characters like: ["{'<( etc .. this way I can remove text like "this is a very ... long text" with a simple keyboard shortcut. I was looking for some already existing mode that performs something similar but I didn't found any so I created some lisp code which performs good in most of situations, however it's not working correctly in all cases. For example if I have the following text entry and I put the cursor in the position"^" then I would liek to remove all the text enclosed by " but it doesn't work:
"aaaaa ] > [more text] aaaaa"
------------ ^
My lisp code is the following:
;; returns the enclosing character for the character "c"
(defun get-enc-char (c) (cond
((string= c "(") ")")
((string= c "[") "]")
((string= c "{") "}")
((string= c ">") "<")
((string= c "<") ">")
((string= c "'") "'")
((string= c "\"") "\"")
(t nil)
)
)
(defun delete-enclosed-text ()
"Delete texts between any pair of delimiters."
(interactive)
(save-excursion
(let (p1 p2 mychar)
; look for one of those characters and store the cursor position
(skip-chars-backward "^([\'\"><{") (setq p1 (point))
; store the char at this point, look for its enclosed char and advance
; the cursor newly (this done to avoid the cases when the char and
; its enclosed-char are the same like " or ' chars.
(backward-char 1) (setq mychar (thing-at-point 'char)) (forward-char 1)
; look forward for the enclosed char
(skip-chars-forward (concatenate 'string "^" (get-enc-char mychar))) (setq p2 (point))
; only delete the region if we found the enclosed character
(if (looking-at "[\]\}\"\'\)<>]") (kill-region p1 p2)))))
Following is an example:
Here a solution based on your code
;; returns the enclosing character for the character "c"
(defun get-enc-char (c) (cond
((string= c "(") ")")
((string= c "[") "]")
((string= c "{") "}")
((string= c ">") "<")
((string= c "<") ">")
((string= c "'") "'")
((string= c "\"") "\"")
(t nil)
))
(defvar empty-enclose 0)
(defun delete-enclosed-text ()
"Delete texts between any pair of delimiters."
(interactive)
(setq empty-enclose 0)
(save-excursion
(let (p1 p2 orig)
(setq orig (point))
(setq p1 (point))
(setq p2 (point))
(setq find 0)
(setq mychar (thing-at-point 'char))
(if (-contains? '("(" "[" "{" "<" "'" "\"") mychar)
(progn
(setq left_encloser (thing-at-point 'char))
(backward-char -1)
(if (string-equal (thing-at-point 'char) (get-enc-char left_encloser))
(progn
(backward-char -1)
(setq p2 (point))
(setq find 1)
(setq empty-enclose 1)))))
(while (eq find 0)
(skip-chars-backward "^({[<>\"'")
(setq p1 (point))
(backward-char 1)
(setq left_encloser (thing-at-point 'char))
(goto-char orig)
(while (and (not (eobp)) (eq find 0))
(backward-char -1)
(skip-chars-forward "^)}]<>\"'")
(setq right_encloser (thing-at-point 'char))
(if (string-equal right_encloser (get-enc-char left_encloser))
(progn
(setq p2 (point))
(setq find 1))))
(goto-char p1)
(backward-char 1))
(delete-region p1 p2)))
(if (eq empty-enclose 0)
(backward-char 1)))
I rapid-sketched something, it doesn't match exactly what you're asking for but I think it could fullfill the same requirements in an even more comfortable way, give it a try and let me know! This interactive function is called with no arguments after selecting a region and asks you for an enclosing mark: this can be any char or string that is directly recognized by replace-regex (direct use of *,.,[ etc wouldn't be the case, but you still can use other chars like {},% etc or even HTML-like markups like <idx>).
The function will delete all text within the selected region, from the very first apparition of the mark to the very last (even if there is an odd number of them), marks are also deleted.
(defun remove-enclosed-in-selection (beginning end)
"select a region, call this function and type any valid regex
markup. All characters from its first to its last appearance will
be removed (including the symbol itself. Example: try with § and %:
aaaa§bbbbcc%c§cc§ddddeeee§ffffgggghhhhiiii§jjjj§kkkkllll§mmmm%nnnn"
(interactive "r")
(let ((x (read-string "type enclosing mark: ")))
(narrow-to-region beginning end)
(replace-regexp (concat x ".*" x) "")
(widen)))
Then you can globally bind it to any keyboard shortcut you want as usual:
(global-set-key (kbd "C-. <C-return>") 'remove-enclosed-in-selection)
or locally to any custom hook you may have:
(defun custom-whatever-hook ()
(local-set-key (kbd "C-. <C-return>")) 'remove-enclosed-in-selection)
(add-hook 'whatever-hook 'custom-whatever-hook)
so, summarizing:
select region
M-x remove-enclosed-in-selection or your custom keystroke
press RET, type valid marker, press RET
the enclosed contents should be removed
The narrow-widen approach seems quick&dirty to me, but I couldn't find another way in the short term. So it may still need a couple of fixes, let me know if it works as expected. Plus, I'm not that an emacs hacker... yet! :P
cheers

Writing major mode: how set different start string and end string character?

I'm writing a major mode where I can have multiline strings like this:
Text : >abcde
fgh
ijklmonp<
where '>' and '<' indicate the respective start and end of the string. The following syntax table entries only mark >...> and <...< strings, which is not what I want.
(modify-syntax-entry ?> "\"" st)
(modify-syntax-entry ?< "\"" st)
Currently the best solution is using generic string delimiters: ‘|’, but it still messes up my system as I have >...<...< situations sometimes. The best would be if I could use a multiline regexp like
^Text : >.*<$
How can I achieve this?
As thornjad explains, this is not supported directly by syntax-table, so you need to use syntax-propertize-function. E.g.
(defconst my-syntax-propertize
(syntax-propertize-rules
(">" (0 (unless (nth 8 (save-excursion (syntax-ppss (match-beginning 0)))
(string-to-syntax "|"))))
("<" (0 (when (eq t (nth 3 (save-excursion
(syntax-ppss (match-beginning 0))))
(string-to-syntax "|"))))))
then in your major mode function:
(setq-local syntax-propertize-function my-syntax-propertize)
The nth 8 test makes sure > is only marked as a string delimiter if it is not within another string or comment, and the nth 3 test makes sure that < is only marked as a string delimiter when it occurs with a string that was started by another generic string delimiter.
Unfortunately modify-syntax-entry isn't powerful enough to handle this sort of situation. Luckily we have other options! My orson-mode deals with a similar issue where strings are delimited by double-single quotes ('') instead of double quotes (").
To do this, a regexp looks for the entire string, quotes included, then uses Emacs's string-fence class to mark the quotes as fences.
(defconst orson--string-rx
"\\(''[^']*''\\)")
(defun orson-syntax-propertize-function (start end)
(save-excursion
(goto-char start)
(while (re-search-forward orson--string-rx end 'noerror)
(let ((a (match-beginning 1))
(b (match-end 1))
(string-fence (string-to-syntax "|")))
(put-text-property a (1+ a) 'syntax-table string-fence)
(put-text-property (1- b) b 'syntax-table string-fence))))

Mapping source code line number to "printed" page number

Sometimes I search in emacs for some variable then try to find which page should I look for in the printout of the file I have in hand.
Is it possible, given the printing parameters I use, to have emacs show a "virtual" page number that maps to the where the cursor is pointing at?
I am trying to play with the "mode line", given that each printed page has 72 lines, then page number = line_number/72+1.
This did not work though:
(setq-default mode-line-format
'("" mode-line-modified ""
mode-line-buffer-identification "-"
"[" mode-name "." mode-line-process "." minor-mode-alist "" "%n" "]"
line-number-mode "-" "L%l"
"-" "P" (+ 1 (/ %l 72))
column-number-mode "-" "C%c"
mode-line-misc-info ""
abbreviated-file-name
"%-"
)
)
Anny pointers?
You can force mode-line updates (force-mode-line-update) with something like the post-command-hook.
(setq-default mode-line-format '(
" "
(:eval (format "Line %s | Page %s"
(line-number-at-pos) (+ 1 (/ (line-number-at-pos) 72)) ))))

emacs character before point equals

How to check whether the character before point equals "\"
(defun comment-latex ()
(interactive)
(if (region-active-p)
(comment-region (region-beginning) (region-end))
(if (= (char-before) ("\\") ;; how to fix this sentence?
(insert "%")
(if (= (point) (line-beginning-position)) ;; this part works
(insert "% ")
(end-of-line)
(insert " % "))))
)
(global-set-key LaTeX-mode-map (kbd "%") 'comment-latex)
The code as example should be doing the following:
1) If a region is selected, the region should be commented.
2) If the character before point is a "\", a normal % should be inserted at point.
3) If point is at the beginning of line, insert a "%"
4) If point is anywhere else, go to the end of the sentence and insert "SPC % SPC"
The syntax for individual characters is ?char. So:
(= (char-before) ?\\)
Replace it with
(= (char-before) 92)
92 is the ASCII code of the \ character.
In e-lisp, a character is not the same as a string. The syntax for getting the ascii value of a character is ?a. Try something like:
(if (= (char-before) ?\\))
DO-SOMETHING
DO-SOMETHING-ELSE)

Highlighting correctly in an emacs major mode

I am developing an emacs major mode for a language (aka mydsl). However, using the techniques on xahlee's site doesn't seem to be working for some reason (possibly older emacs dialect..)
The key issues I am fighting with are (1) highlighting comments is not working and (2), the use of regexp-opt lines is not working.
I've reviewed the GNU manual and looked over cc-mode and elisp mode... those are significantly more complicated than I need.
;;;Standard # to newline comment
;;;Eventually should also have %% to %% multiline block comments
(defun mydsl-comment-dwim (arg)
"comment or uncomment"
(interactive "*P")
(require 'newcomment)
(let
((deactivate-mark nil)
(comment-start "#")
(comment-end "")
comment-dwim arg)))
(defvar mydsl-events
'("reservedword1"
"reservedword2"))
(defvar mydsl-keywords
'("other-keyword" "another-keyword"))
;;Highlight various elements
(setq mydsl-hilite
'(
; stuff between "
("\"\\.\\*\\?" . font-lock-string-face)
; : , ; { } => # $ = are all special elements
(":\\|,\\|;\\|{\\|}\\|=>\\|#\\|$\\|=" . font-lock-keyword-face)
( ,(regexp-opt mydsl-keywords 'words) . font-lock-builtin-face)
( ,(regexp-opt mydsl-events 'words) . font-lock-constant-face)
))
(defvar mydsl-tab-width nil "Width of a tab for MYDSL mode")
(define-derived-mode mydsl-mode fundamental-mode
"MYDSL mode is a major mode for editing MYDSL files"
;Recommended by manual
(kill-all-local-variables)
(setq mode-name "MYDSL script")
(setq font-lock-defaults '((mydsl-hilite)))
(if (null mydsl-tab-width)
(setq tab-width mydsl-tab-width)
(setq tab-width default-tab-width)
)
;Comment definitions
(define-key mydsl-mode-map [remap comment-dwim] 'mydsl-comment-dwim)
(modify-syntax-entry ?# "< b" mydsl-mode-syntax-table)
(modify-syntax-entry ?\n "> b" mydsl-mode-syntax-table)
;;A gnu-correct program will have some sort of hook call here.
)
(provide 'mydsl-mode)
You have a couple of syntactic problems in your code, but you got it nearly correct. Here's my edited version which appears to do the right thing for a buffer in mydsl-mode:
; No changes to the simple vars
(defvar mydsl-events
'("reservedword1"
"reservedword2"))
(defvar mydsl-keywords
'("other-keyword" "another-keyword"))
;; I'd probably put in a default that you want, as opposed to nil
(defvar mydsl-tab-width nil "Width of a tab for MYDSL mode")
;; Two small edits.
;; First is to put an extra set of parens () around the list
;; which is the format that font-lock-defaults wants
;; Second, you used ' (quote) at the outermost level where you wanted ` (backquote)
;; you were very close
(defvar mydsl-font-lock-defaults
`((
;; stuff between "
("\"\\.\\*\\?" . font-lock-string-face)
;; ; : , ; { } => # $ = are all special elements
(":\\|,\\|;\\|{\\|}\\|=>\\|#\\|$\\|=" . font-lock-keyword-face)
( ,(regexp-opt mydsl-keywords 'words) . font-lock-builtin-face)
( ,(regexp-opt mydsl-events 'words) . font-lock-constant-face)
)))
(define-derived-mode mydsl-mode fundamental-mode "MYDSL script"
"MYDSL mode is a major mode for editing MYDSL files"
;; fundamental-mode kills all local variables, no need to do it again
(setq mode-name "MYDSL script")
;; you again used quote when you had '((mydsl-hilite))
;; I just updated the variable to have the proper nesting (as noted above)
;; and use the value directly here
(setq font-lock-defaults mydsl-font-lock-defaults)
;; when there's an override, use it
;; otherwise it gets the default value
(when mydsl-tab-width
(setq tab-width mydsl-tab-width))
;; for comments
;; overriding these vars gets you what (I think) you want
;; they're made buffer local when you set them
(setq comment-start "#")
(setq comment-end "")
(modify-syntax-entry ?# "< b" mydsl-mode-syntax-table)
(modify-syntax-entry ?\n "> b" mydsl-mode-syntax-table)
;;A gnu-correct program will have some sort of hook call here.
)
(provide 'mydsl-mode)